home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / C and C++ / Entertainment / MacMud / Mud 4.0 / interpret.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-03-24  |  121.8 KB  |  5,073 lines  |  [TEXT/MPS ]
  1. #include <varargs.h>
  2. #include <stdio.h>
  3. #include <setjmp.h>
  4. #include <string.h>
  5. #include <ctype.h>
  6. #include <sys/types.h>
  7. #include <types.h>
  8. #include <cursorctl.h>
  9. #include <desk.h>
  10. #include <mac.h>
  11. #include <memory.h>
  12.  
  13. #define CASE(x) case x:
  14.  
  15. #include "lint.h"
  16. #include "lang.h"
  17. #include "exec.h"
  18. #include "interpret.h"
  19. #include "config.h"
  20. #include "object.h"
  21. #include "wiz_list.h"
  22. #include "instrs.h"
  23. #include "patchlevel.h"
  24. #include "comm.h"
  25. #include "switch.h"
  26. #include "rc.h"
  27. #ifdef NLHACK
  28. #include "nlhack.h"
  29. #endif
  30.  
  31. #define INLINE
  32. #define WNETICKINTERVAL    8
  33.  
  34. /* mapping prototypes */
  35.  
  36. struct vector *allocate_mapping PROT((struct vector*, struct vector*));
  37. void free_mapping PROT((struct vector*));
  38. struct svalue *get_map_lvalue PROT((struct vector*, struct svalue*, int));
  39. void remove_mapping PROT((struct vector *, int));
  40. struct vector *add_mapping PROT((struct vector*, struct vector*));
  41. struct vector *filter_mapping PROT((struct vector*, char*, struct object*,
  42.                     struct svalue*));
  43. struct vector *map_mapping PROT((struct vector*, char*, struct object*,
  44.                  struct svalue*));
  45.  
  46. extern struct object *master_ob;
  47.  
  48. extern void print_svalue PROT((struct svalue *));
  49. extern struct vector *order_alist PROT((struct vector *));
  50. extern int assoc PROT((struct svalue *key, struct vector *keys));
  51. extern char *findstring PROT ((char *));
  52.  
  53. static struct svalue *sapply PROT((char *, struct object *, int));
  54. static void do_trace PROT((char *, char *, char *));
  55. #ifdef CACHE_CALL_OTHER
  56. static int apply_low PROT((char *, struct object *, int, short *));
  57. #else
  58. static int apply_low PROT((char *, struct object *, int));
  59. #endif
  60. static int inter_sscanf PROT((int));
  61. static int strpref PROT((char *, char *));
  62. extern int do_rename PROT((char *, char *));     
  63.  
  64. extern struct object *previous_ob;
  65. extern char *last_verb;
  66. extern struct svalue const0, const1;
  67. struct program *current_prog;
  68. extern int current_time;
  69. extern struct object *current_heart_beat, *current_interactive;
  70.  
  71. static int tracedepth;
  72. #define TRACE_CALL 1
  73. #define TRACE_CALL_OTHER 2
  74. #define TRACE_RETURN 4
  75. #define TRACE_ARGS 8
  76. #define TRACE_EXEC 16
  77. #define TRACE_HEART_BEAT 32
  78. #define TRACE_APPLY 64
  79. #define TRACE_OBJNAME 128
  80. #define TRACETST(b) (command_giver->interactive->trace_level & (b))
  81. #define TRACEP(b) \
  82.     (command_giver && command_giver->interactive && TRACETST(b) && \
  83.      (command_giver->interactive->trace_prefix == 0 || \
  84.       (current_object && strpref(command_giver->interactive->trace_prefix, \
  85.           current_object->name))) )
  86. #define TRACEHB (current_heart_beat == 0 || (command_giver->interactive->trace_level & TRACE_HEART_BEAT))
  87.  
  88. /*
  89.  * Inheritance:
  90.  * An object X can inherit from another object Y. This is done with
  91.  * the statement 'inherit "file";'
  92.  * The inherit statement will clone a copy of that file, call reset
  93.  * in it, and set a pointer to Y from X.
  94.  * Y has to be removed from the linked list of all objects.
  95.  * All variables declared by Y will be copied to X, so that X has access
  96.  * to them.
  97.  *
  98.  * If Y isn't loaded when it is needed, X will be discarded, and Y will be
  99.  * loaded separetly. X will then be reloaded again.
  100.  */
  101. extern int d_flag;
  102.  
  103. extern int current_line, eval_cost;
  104.  
  105. /*
  106.  * These are the registers used at runtime.
  107.  * The control stack saves registers to be restored when a function
  108.  * will return. That means that control_stack[0] will have almost no
  109.  * interesting values, as it will terminate execution.
  110.  */
  111. static char *pc;        /* Program pointer. */
  112. static struct svalue *fp;    /* Pointer to first argument. */
  113. static struct svalue *sp;    /* Points to value of last push. */
  114. static short *break_sp;        /* Points to address to branch to
  115.                  * at next F_BREAK            */
  116. static int function_index_offset; /* Needed for inheritance */
  117. static int variable_index_offset; /* Needed for inheritance */
  118.  
  119. struct svalue *start_of_stack;
  120. struct svalue catch_value;    /* Used to throw an error to a catch */
  121.  
  122. struct control_stack *control_stack;
  123. static struct control_stack *csp;    /* Points to last element pushed */
  124.  
  125. /*
  126.  * May current_object shadow object 'ob' ? We rely heavily on the fact that
  127.  * function names are pointers to shared strings, which means that equality
  128.  * can be tested simply through pointer comparison.
  129.  */
  130. int validate_shadowing(ob)
  131.     struct object *ob;
  132. {
  133.     int i, j;
  134.     struct program *shadow = current_object->prog, *victim = ob->prog;
  135.     struct svalue *ret;
  136.  
  137.     if (current_object->shadowing)
  138.     error("shadow: Already shadowing.\n");
  139.     if (current_object->shadowed)
  140.     error("shadow: Can't shadow when shadowed.\n");
  141.     if (current_object->super)
  142.     error("The shadow must not reside inside another object.\n");
  143.     if (ob->shadowing)
  144.     error("Can't shadow a shadow.\n");
  145.     for (i=0; i < shadow->num_functions; i++) {
  146.     for (j=0; j < victim->num_functions; j++) {
  147.         if (shadow->functions[i].name != victim->functions[j].name)
  148.         continue;
  149.         if (victim->functions[j].type & TYPE_MOD_NO_MASK)
  150.         error("Illegal to shadow 'nomask' function \"%s\".\n",
  151.               victim->functions[j].name);
  152.     }
  153.     }
  154.     push_object(ob);
  155.     ret = apply_master_ob("query_allow_shadow", 1);
  156.     if (!(ob->flags & O_DESTRUCTED) &&
  157.     ret && !(ret->type == T_NUMBER && ret->u.number == 0))
  158.     {
  159.     return 1;
  160.     }
  161.     return 0;
  162. }
  163.  
  164. /*
  165.  * Information about assignments of values:
  166.  *
  167.  * There are three types of l-values: Local variables, global variables
  168.  * and vector elements.
  169.  *
  170.  * The local variables are allocated on the stack together with the arguments.
  171.  * the register 'frame_pointer' points to the first argument.
  172.  *
  173.  * The global variables must keep their values between executions, and
  174.  * have space allocated at the creation of the object.
  175.  *
  176.  * Elements in vectors are similar to global variables. There is a reference
  177.  * count to the whole vector, that states when to deallocate the vector.
  178.  * The elements consists of 'struct svalue's, and will thus have to be freed
  179.  * immediately when over written.
  180.  */
  181.  
  182. /*
  183.  * Push an object pointer on the stack. Note that the reference count is
  184.  * incremented.
  185.  * A destructed object must never be pushed onto the stack.
  186.  */
  187. INLINE
  188. void push_object(ob)
  189.     struct object *ob;
  190. {
  191.     sp++;
  192.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  193.     fatal("stack overflow\n");
  194.     sp->type = T_OBJECT;
  195.     sp->u.ob = ob;
  196.     add_ref(ob, "push_object");
  197. }
  198.  
  199. /*
  200.  * Push a number on the value stack.
  201.  */
  202. INLINE
  203. void push_number(n)
  204.     int n;
  205. {
  206.     sp++;
  207.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  208.     fatal("stack overflow\n");
  209.     sp->type = T_NUMBER;
  210.     sp->u.number = n;
  211. }
  212.  
  213. /*
  214.  * Push a string on the value stack.
  215.  */
  216. INLINE
  217. void push_string(p, type)
  218.     char *p;
  219.     int type;
  220. {
  221.     sp++;
  222.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  223.     fatal("stack overflow\n");
  224.     sp->type = T_STRING;
  225.     sp->string_type = type;
  226.     switch(type) {
  227.     case STRING_MALLOC:
  228.     sp->u.string = string_copy(p);
  229.     break;
  230.     case STRING_SHARED:
  231.     sp->u.string = make_shared_string(p);
  232.     break;
  233.     case STRING_CONSTANT:
  234.     sp->u.string = p;
  235.     break;
  236.     }
  237. }
  238.  
  239. /*
  240.  * Get address to a valid global variable.
  241.  */
  242. static INLINE struct svalue *find_value(num)
  243.     int num;
  244. {
  245. #ifdef DEBUG
  246.     if (num >= current_object->prog->num_variables) {
  247.     fatal("Illegal variable access %d(%d). See trace above.\n",
  248.         num, current_object->prog->num_variables);
  249.     }
  250. #endif
  251.     return ¤t_object->variables[num];
  252. }
  253.  
  254. /*
  255.  * Free the data that an svalue is pointing to. Not the svalue
  256.  * itself.
  257.  */
  258. void free_svalue(v)
  259.     struct svalue *v;
  260. {
  261.     switch(v->type) {
  262.     case T_STRING:
  263.     switch(v->string_type) {
  264.     case STRING_MALLOC:
  265.         xfree(v->u.string);
  266.         break;
  267.     case STRING_SHARED:
  268.         free_string(v->u.string);
  269.         break;
  270.     }
  271.     break;
  272.     case T_OBJECT:
  273.     free_object(v->u.ob, "free_svalue");
  274.     break;
  275.     case T_POINTER:
  276.     free_vector(v->u.vec);
  277.     break;
  278.     case T_MAPPING:
  279.     free_mapping(v->u.vec);
  280.     break;
  281.     }
  282.     *v = const0; /* marion - clear this value all away */
  283. }
  284.  
  285. #ifndef COMPAT_MODE
  286. /*
  287.  * Prepend a slash in front of a string.
  288.  */
  289. static char *add_slash(str)
  290.     char *str;
  291. {
  292.     char *tmp;
  293.  
  294.     tmp = xalloc(strlen(str)+2);
  295.     strcpy(tmp,"/"); strcat(tmp,str);
  296.     return tmp;
  297. }
  298. #endif
  299.  
  300. /*
  301.  * Assign to a svalue.
  302.  * This is done either when element in vector, or when to an identifier
  303.  * (as all identifiers are kept in a vector pointed to by the object).
  304.  */
  305.  
  306. INLINE void assign_svalue_no_free(to, from)
  307.     struct svalue *to;
  308.     struct svalue *from;
  309. {
  310. #ifdef DEBUG
  311.     if (from == 0)
  312.     fatal("Null pointer to assign_svalue().\n");
  313. #endif
  314.     *to = *from;
  315.     switch(from->type) {
  316.     case T_STRING:
  317.     switch(from->string_type) {
  318.     case STRING_MALLOC:    /* No idea to make the string shared */
  319.         to->u.string = string_copy(from->u.string);
  320.         break;
  321.     case STRING_CONSTANT:    /* Good idea to make it shared */
  322.         to->string_type = STRING_SHARED;
  323.         /* FALL THROUGH ! */
  324.     case STRING_SHARED:    /* It already is shared */
  325.         to->u.string = make_shared_string(from->u.string);
  326.         break;
  327.     default:
  328.         fatal("Bad string type %d\n", from->string_type);
  329.     }
  330.     break;
  331.     case T_OBJECT:
  332.     add_ref(to->u.ob, "ass to var");
  333.     break;
  334.     case T_POINTER:
  335.     case T_MAPPING:
  336.     to->u.vec->ref++;
  337.     break;
  338.     }
  339. }
  340.  
  341. INLINE void assign_svalue(dest, v)
  342.     struct svalue *dest;
  343.     struct svalue *v;
  344. {
  345.     /* First deallocate the previous value. */
  346.     free_svalue(dest);
  347.     assign_svalue_no_free(dest, v);
  348. }
  349.  
  350. void push_svalue(v)
  351.     struct svalue *v;
  352. {
  353.     sp++;
  354.     assign_svalue_no_free(sp, v);
  355. }
  356.  
  357. /*
  358.  * Pop the top-most value of the stack.
  359.  * Don't do this if it is a value that will be used afterwards, as the
  360.  * data may be sent to free(), and destroyed.
  361.  */
  362. static INLINE void pop_stack() {
  363. #ifdef DEBUG
  364.     if (sp < start_of_stack)
  365.     fatal("Stack underflow.\n");
  366. #endif
  367.     free_svalue(sp);
  368.     sp--;
  369. }
  370.  
  371. /*
  372.  * Compute the address of an array element.
  373.  */
  374. static INLINE void push_indexed_lvalue(needlval)
  375. int needlval;
  376. {
  377.     struct svalue *i, *vec, *item;
  378.     int ind;
  379.  
  380.     i = sp;
  381.     vec = sp - 1;
  382.     if (vec->type != T_MAPPING) {
  383.     if (i->type != T_NUMBER || i->u.number < 0)
  384.         error("Illegal index\n");
  385.     ind = i->u.number;
  386.     }
  387.     switch (vec->type) {
  388.     case T_STRING: {
  389.     static struct svalue one_character;
  390.     /* marion says: this is a crude part of code */
  391.     pop_stack();
  392.     one_character.type = T_NUMBER;
  393.     if (ind > strlen(vec->u.string) || ind < 0)
  394.         one_character.u.number = 0;
  395.     else
  396.         one_character.u.number = vec->u.string[ind];
  397.     free_svalue(sp);
  398.     sp->type = T_LVALUE;
  399.     sp->u.lvalue = &one_character;
  400.     break;}
  401.     case T_POINTER:
  402.     pop_stack();
  403.     if (ind >= vec->u.vec->size) error ("Index out of bounds\n");
  404.     item = &vec->u.vec->item[ind];
  405.     if (vec->u.vec->ref == 1) {
  406.         static struct svalue quickfix = { T_NUMBER };
  407.         /* marion says: but this is crude too */
  408.         /* marion blushes. */
  409.         assign_svalue (&quickfix, item);
  410.         item = &quickfix;
  411.     }
  412.     free_svalue(sp);    /* This will make 'vec' invalid to use */
  413.     sp->type = T_LVALUE;
  414.     sp->u.lvalue = item;
  415.     break;
  416.     case T_MAPPING:
  417.     item = get_map_lvalue(vec->u.vec, i, needlval);
  418.     pop_stack();
  419.     if (vec->u.vec->ref == 1) {
  420.         static struct svalue quickfix = { T_NUMBER };
  421.         assign_svalue (&quickfix, item);
  422.         item = &quickfix;
  423.     }
  424.     free_svalue(sp);    /* This will make 'vec' invalid to use */
  425.     sp->type = T_LVALUE;
  426.     sp->u.lvalue = item;
  427.     break;
  428.     default:
  429.     error("Indexing on illegal type.\n");
  430.     break;
  431.     }
  432. }
  433.  
  434. #ifdef OPCPROF
  435. #define MAXOPC 512
  436. static int opcount[MAXOPC];
  437. #endif
  438.  
  439. /*
  440.  * Deallocate 'n' values from the stack.
  441.  */
  442. INLINE
  443. void pop_n_elems(n)
  444.     int n;
  445. {
  446. #ifdef DEBUG
  447.     if (n < 0)
  448.     fatal("pop_n_elems: %d elements.\n", n);
  449. #endif
  450.     for (; n>0; n--)
  451.     pop_stack();
  452. }
  453.  
  454. void bad_arg(arg, instr)
  455.     int arg, instr;
  456. {
  457.     error("Bad argument %d to %s()\n", arg, get_f_name(instr));
  458. }
  459.  
  460. INLINE
  461. static void push_control_stack(funp)
  462.     struct function *funp;
  463. {
  464.     if (csp == &control_stack[MAX_TRACE-1])
  465.     error("Too deep recursion.\n");
  466.     csp++;
  467.     csp->funp = funp;    /* Only used for tracebacks */
  468.     csp->ob = current_object;
  469.     csp->prev_ob = previous_ob;
  470.     csp->fp = fp;
  471.     csp->prog = current_prog;
  472.     /* csp->extern_call = 0; It is set by eval_instruction() */
  473.     csp->pc = pc;
  474.     csp->function_index_offset = function_index_offset;
  475.     csp->variable_index_offset = variable_index_offset;
  476.     csp->break_sp = break_sp;
  477. }
  478.  
  479. /*
  480.  * Pop the control stack one element, and restore registers.
  481.  * extern_call must not be modified here, as it is used imediately after pop.
  482.  */
  483. static void pop_control_stack() {
  484. #ifdef DEBUG
  485.     if (csp == control_stack - 1)
  486.     fatal("Popped out of the control stack");
  487. #endif
  488.     current_object = csp->ob;
  489.     current_prog = csp->prog;
  490.     previous_ob = csp->prev_ob;
  491.     pc = csp->pc;
  492.     fp = csp->fp;
  493.     function_index_offset = csp->function_index_offset;
  494.     variable_index_offset = csp->variable_index_offset;
  495.     break_sp = csp->break_sp;
  496.     csp--;
  497. }
  498.  
  499. /*
  500.  * Push a pointer to a vector on the stack. Note that the reference count
  501.  * is incremented. Newly created vectors normally have a reference count
  502.  * initialized to 1.
  503.  */
  504. INLINE void push_vector(v)
  505.     struct vector *v;
  506. {
  507.     v->ref++;
  508.     sp++;
  509.     sp->type = T_POINTER;
  510.     sp->u.vec = v;
  511. }
  512.  
  513. INLINE void push_mapping(v)
  514.     struct vector *v;
  515. {
  516.     v->ref++;
  517.     sp++;
  518.     sp->type = T_MAPPING;
  519.     sp->u.vec = v;
  520. }
  521.  
  522. /*
  523.  * Push a string on the stack that is already malloced.
  524.  */
  525. static void INLINE push_malloced_string(p)
  526.     char *p;
  527. {
  528.     sp++;
  529.     sp->type = T_STRING;
  530.     sp->u.string = p;
  531.     sp->string_type = STRING_MALLOC;
  532. }
  533.  
  534. /*
  535.  * Push a string on the stack that is already constant.
  536.  */
  537. INLINE
  538. void push_constant_string(p)
  539.     char *p;
  540. {
  541.     sp++;
  542.     sp->type = T_STRING;
  543.     sp->u.string = p;
  544.     sp->string_type = STRING_CONSTANT;
  545. }
  546.  
  547. static void do_trace_call(funp)
  548.     struct function *funp;
  549. {
  550.     do_trace("Call direct ", funp->name, " ");
  551.     if (TRACEHB) {
  552.         if (TRACETST(TRACE_ARGS)) {
  553.             int i;
  554.             add_message(" with %d arguments: ", funp->num_arg);
  555.             for(i = funp->num_arg-1; i >= 0; i--) {
  556.                 print_svalue(&sp[-i]);
  557.                 add_message(" ");
  558.             }
  559.         }
  560.         add_message("\n");
  561.     }
  562. }
  563.  
  564. /*
  565.  * Argument is the function to execute. If it is defined by inheritance,
  566.  * then search for the real definition, and return it.
  567.  * There is a number of arguments on the stack. Normalize them and initialize
  568.  * local variables, so that the called function is pleased.
  569.  */
  570. static struct function *setup_new_frame(funp)
  571.     struct function *funp;
  572. {
  573.     function_index_offset = 0;
  574.     variable_index_offset = 0;
  575.     while(funp->flags & NAME_INHERITED) {
  576.     function_index_offset +=
  577.         current_prog->inherit[funp->offset].function_index_offset;
  578.     variable_index_offset +=
  579.         current_prog->inherit[funp->offset].variable_index_offset;
  580.     current_prog =
  581.         current_prog->inherit[funp->offset].prog;
  582.     funp = ¤t_prog->functions[funp->function_index_offset];
  583.     }
  584.     /* Remove excessive arguments */
  585.     while(csp->num_local_variables > funp->num_arg) {
  586.     pop_stack();
  587.     csp->num_local_variables--;
  588.     }
  589.     /* Correct number of arguments and local variables */
  590.     while(csp->num_local_variables < funp->num_arg + funp->num_local) {
  591.     push_number(0);
  592.     csp->num_local_variables++;
  593.     }
  594.     tracedepth++;
  595.     if (TRACEP(TRACE_CALL)) {
  596.     do_trace_call(funp);
  597.     }
  598.     fp = sp - csp->num_local_variables + 1;
  599.     break_sp = (short*)(sp+1);
  600.     return funp;
  601. }
  602.  
  603. static void break_point()
  604. {
  605.     if (sp - fp - csp->num_local_variables + 1 != 0)
  606.     fatal("Bad stack pointer.\n");
  607. }
  608.  
  609. /* marion
  610.  * maintain a small and inefficient stack of error recovery context
  611.  * data structures.
  612.  * This routine is called in three different ways:
  613.  * push=-1    Pop the stack.
  614.  * push=1    push the stack.
  615.  * push=0    No error occured, so the pushed value does not have to be
  616.  *        restored. The pushed value can simply be popped into the void.
  617.  *
  618.  * The stack is implemented as a linked list of stack-objects, allocated
  619.  * from the heap, and deallocated when popped.
  620.  */
  621. void push_pop_error_context (push)
  622.     int push;
  623. {
  624.     extern jmp_buf error_recovery_context;
  625.     extern int error_recovery_context_exists;
  626.     static struct error_context_stack {
  627.     jmp_buf old_error_context;
  628.     int old_exists_flag;
  629.     struct control_stack *save_csp;
  630.     struct object *save_command_giver;
  631.     struct svalue *save_sp;
  632.     struct error_context_stack *next;
  633.     } *ecsp = 0, *p;
  634.  
  635.     if (push == 1) {
  636.     /*
  637.      * Save some global variables that must be restored separately
  638.      * after a longjmp. The stack will have to be manually popped all
  639.      * the way.
  640.      */
  641.     p = (struct error_context_stack *)xalloc (sizeof *p);
  642.     p->save_sp = sp;
  643.     p->save_csp = csp;    
  644.     p->save_command_giver = command_giver;
  645.     memcpy (
  646.         (char *)p->old_error_context,
  647.         (char *)error_recovery_context,
  648.         sizeof error_recovery_context);
  649.     p->old_exists_flag = error_recovery_context_exists;
  650.     p->next = ecsp;
  651.     ecsp = p;
  652.     } else {
  653.     p = ecsp;
  654.     if (p == 0)
  655.         fatal("Catch: error context stack underflow");
  656.     if (push == 0) {
  657. #ifdef DEBUG
  658.         if (csp != p->save_csp-1)
  659.         fatal("Catch: Lost track of csp");
  660. #if 0
  661.         /*
  662.          * This test is not valid! The statement catch(exec("...")) will
  663.          * change the value of command_giver.
  664.          */
  665.         if (command_giver != p->save_command_giver)
  666.         fatal("Catch: Lost track of command_giver");
  667. #endif
  668. #endif
  669.     } else {
  670.         /* push == -1 !
  671.          * They did a throw() or error. That means that the control
  672.          * stack must be restored manually here.
  673.          */
  674.         csp = p->save_csp;    
  675.         pop_n_elems (sp - p->save_sp);
  676.         command_giver = p->save_command_giver;
  677.     }
  678.     memcpy ((char *)error_recovery_context,
  679.         (char *)p->old_error_context,
  680.         sizeof error_recovery_context);
  681.     error_recovery_context_exists = p->old_exists_flag;
  682.     ecsp = p->next;
  683.     xfree ((char *)p);
  684.     }
  685. }
  686.  
  687. /*
  688.  * When a vector is given as argument to an efun, all items has to be
  689.  * checked if there would be an destructed object.
  690.  * A bad problem currently is that a vector can contain another vector, so this
  691.  * should be tested too. But, there is currently no prevention against
  692.  * recursive vectors, which means that this can not be tested. Thus, the game
  693.  * may crash if a vector contains a vector that contains a destructed object
  694.  * and this top-most vector is used as an argument to an efun.
  695.  */
  696. /* The game won't crash when doing simple operations like assign_svalue
  697.  * on a destructed object. You have to watch out, of course, that you don't
  698.  * apply a function to it.
  699.  * to save space it is preferable that destructed objects are freed soon.
  700.  *   amylaar
  701.  */
  702. void check_for_destr(v)
  703.     struct vector *v;
  704. {
  705.     int i;
  706.  
  707.     for (i=0; i < v->size; i++) {
  708.     if (v->item[i].type != T_OBJECT)
  709.         continue;
  710.     if (!(v->item[i].u.ob->flags & O_DESTRUCTED))
  711.         continue;
  712.     assign_svalue(&v->item[i], &const0);
  713.     }
  714. }
  715.  
  716. void check_map_for_destr(m)
  717.     struct vector *m;
  718. {
  719.     int i;
  720.     struct vector *v;
  721.  
  722.     v = m->item[0].u.vec;
  723.     for (i=0; i < v->size; ) {
  724.     if (v->item[i].type == T_OBJECT &&
  725.         (v->item[i].u.ob->flags & O_DESTRUCTED)) {
  726.         remove_mapping(m, i);
  727.         v = m->item[0].u.vec;
  728.     } else {
  729.         i++;
  730.     }
  731.     }
  732.     v = m->item[1].u.vec;
  733.     for (i=0; i < v->size; i++) {
  734.     if (v->item[i].type != T_OBJECT)
  735.         continue;
  736.     if (!(v->item[i].u.ob->flags & O_DESTRUCTED))
  737.         continue;
  738.     assign_svalue(&v->item[i], &const0);
  739.     }
  740. }
  741.  
  742. /*
  743.  * Evaluate instructions at address 'p'. All program offsets are
  744.  * to current_prog->program. 'current_prog' must be setup before
  745.  * call of this function.
  746.  *
  747.  * There must not be destructed objects on the stack. The destruct_object()
  748.  * function will automatically remove all occurences. The effect is that
  749.  * all called efuns knows that they won't have destructed objects as
  750.  * arguments.
  751.  */
  752. #ifdef TRACE_CODE
  753. int previous_instruction[60];
  754. int stack_size[60];
  755. char *previous_pc[60];
  756. static int last;
  757. #endif
  758.  
  759. #ifdef mac
  760. #pragma segment evaluation
  761. #endif
  762.  
  763. static void eval_instruction(p)
  764.     char *p;
  765. {
  766.     long thissec;
  767.     long lastsec = 0;
  768.     struct object *ob;
  769.     int i, num_arg;
  770.     int instruction;
  771.     struct svalue *expected_stack, *argp;
  772.  
  773.     /* Next F_RETURN at this level will return out of eval_instruction() */
  774.     csp->extern_call = 1;
  775.     pc = p;
  776. again:
  777.     instruction = EXTRACT_UCHAR(pc);
  778. #ifdef TRACE_CODE
  779.     previous_instruction[last] = instruction + F_OFFSET;
  780.     previous_pc[last] = pc;
  781.     stack_size[last] = sp - fp - csp->num_local_variables;
  782.     last = (last + 1) % (sizeof previous_instruction / sizeof (int));
  783. #endif
  784.     pc++;
  785.  
  786.     thissec = TickCount();
  787.     if (thissec > lastsec + WNETICKINTERVAL ||
  788.         thissec < lastsec - WNETICKINTERVAL)
  789.     {
  790.         extern void LPEvents(void);
  791.         extern Boolean gInterpActive;
  792.  
  793.         gInterpActive = true;
  794.         LPEvents();
  795.         gInterpActive = false;
  796.         lastsec = TickCount();
  797.     }
  798.  
  799.     if (current_object->user)
  800.     current_object->user->cost++;
  801.     eval_cost++;
  802.     if (eval_cost > MAX_COST) {
  803.     printf("eval_cost too big %d\n", eval_cost);
  804.         eval_cost = 0;
  805.     error("Too long evaluation. Execution aborted.\n");
  806.     }
  807.     /*
  808.      * Execute current instruction. Note that all functions callable
  809.      * from LPC must return a value. This does not apply to control
  810.      * instructions, like F_JUMP.
  811.      */
  812.     if (instrs[instruction].min_arg != instrs[instruction].max_arg) {
  813.     num_arg = EXTRACT_UCHAR(pc);
  814.     pc++;
  815.     if (num_arg > 0) {
  816.         if (instrs[instruction].type[0] != 0 &&
  817.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  818.         bad_arg(1, instruction + F_OFFSET);
  819.         }
  820.     }
  821.     if (num_arg > 1) {
  822.         if (instrs[instruction].type[1] != 0 &&
  823.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  824.         bad_arg(2, instruction + F_OFFSET);
  825.         }
  826.     }
  827.     } else {
  828.     num_arg = instrs[instruction].min_arg;
  829.     if (instrs[instruction].min_arg > 0) {
  830.         if (instrs[instruction].type[0] != 0 &&
  831.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  832.         bad_arg(1, instruction + F_OFFSET);
  833.         }
  834.     }
  835.     if (instrs[instruction].min_arg > 1) {
  836.         if (instrs[instruction].type[1] != 0 &&
  837.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  838.         bad_arg(2, instruction + F_OFFSET);
  839.         }
  840.     }
  841.     /*
  842.      * Safety measure. It is supposed that the evaluator knows
  843.      * the number of arguments.
  844.      */
  845.     num_arg = -1;
  846.     }
  847.     if (num_arg != -1) {
  848.     expected_stack = sp - num_arg + 1;
  849. #ifdef DEBUG
  850.     } else {
  851.     expected_stack = 0;
  852. #endif
  853.     }
  854.     instruction += F_OFFSET;
  855. #ifdef OPCPROF
  856.     if (instruction >= 0 && instruction < MAXOPC) opcount[instruction]++;
  857. #endif
  858.     /*
  859.      * Execute the instructions. The number of arguments are correct,
  860.      * and the type of the two first arguments are also correct.
  861.      */
  862.     if (TRACEP(TRACE_EXEC)) {
  863.     do_trace("Exec ", get_f_name(instruction), "\n");
  864.     }
  865.     switch(instruction) {
  866.     default:
  867. #ifdef NLHACK
  868.     if (nlhack(instruction, pc, fp, sp, num_arg))
  869.         break;
  870. #endif
  871.     fatal("Undefined instruction %s (%d)\n", get_f_name(instruction),
  872.           instruction);
  873.     /*NOTREACHED*/
  874.     CASE(F_REGEXP);
  875.     {
  876.     struct vector *v;
  877.     v = match_regexp((sp-1)->u.vec, sp->u.string);
  878.     pop_n_elems(2);
  879.     if (v == 0)
  880.         push_number(0);
  881.     else {
  882.         push_vector(v);
  883.         v->ref--;        /* Will make ref count == 1 */
  884.     }
  885.     break;
  886.     }
  887.     CASE(F_SHADOW);
  888.     ob = (sp-1)->u.ob;
  889.     if (sp->u.number == 0) {
  890.         ob = ob->shadowed;
  891.         pop_n_elems(2);
  892.         if (ob)
  893.         push_object(ob);
  894.         else
  895.         push_number(0);
  896.         break;
  897.     }
  898.     if (validate_shadowing(ob)) {
  899.         /*
  900.          * The shadow is entered first in the chain.
  901.          */
  902.         while (ob->shadowed)
  903.         ob = ob->shadowed;
  904.         current_object->shadowing = ob;
  905.         ob->shadowed = current_object;
  906.         pop_n_elems(2);
  907.         push_object(ob);
  908.         break;
  909.     }
  910.     pop_n_elems(2);
  911.     push_number(0);
  912.     break;
  913.     CASE(F_POP_VALUE);
  914.     pop_stack();
  915.     break;
  916.     CASE(F_DUP);
  917.     sp++;
  918.     assign_svalue_no_free(sp, sp-1);
  919.     break;
  920.     CASE(F_JUMP_WHEN_ZERO);
  921.     {
  922.     unsigned short offset;
  923.  
  924.     ((char *)&offset)[0] = pc[0];
  925.     ((char *)&offset)[1] = pc[1];
  926.     if (sp->type == T_NUMBER && sp->u.number == 0)
  927.         pc = current_prog->program + offset;
  928.     else
  929.         pc += 2;
  930.     pop_stack();
  931.     break;
  932.     }
  933.     CASE(F_JUMP);
  934.     {
  935.     unsigned short offset;
  936.  
  937.     ((char *)&offset)[0] = pc[0];
  938.     ((char *)&offset)[1] = pc[1];
  939.     pc = current_prog->program + offset;
  940.     break;
  941.     }
  942.     CASE(F_JUMP_WHEN_NON_ZERO);
  943.     {
  944.     unsigned short offset;
  945.  
  946.     ((char *)&offset)[0] = pc[0];
  947.     ((char *)&offset)[1] = pc[1];
  948.     if (sp->type == T_NUMBER && sp->u.number == 0)
  949.         pc += 2;
  950.     else
  951.         pc = current_prog->program + offset;
  952.     pop_stack();
  953.     break;
  954.     }
  955.     CASE(F_INDIRECT);
  956. #ifdef DEBUG
  957.     if (sp->type != T_LVALUE)
  958.         fatal("Bad type to F_INDIRECT\n");
  959. #endif
  960.     assign_svalue(sp, sp->u.lvalue);
  961.     /*
  962.      * Fetch value of a variable. It is possible that it is a variable
  963.      * that points to a destructed object. In that case, it has to
  964.      * be replaced by 0.
  965.      */
  966.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  967.         free_svalue(sp);
  968.         *sp = const0;
  969.     }
  970.     break;
  971.     CASE(F_IDENTIFIER);
  972.     sp++;
  973.     assign_svalue_no_free(sp, find_value((int)(EXTRACT_UCHAR(pc) +
  974.                            variable_index_offset)));
  975.     pc++;
  976.     /*
  977.      * Fetch value of a variable. It is possible that it is a variable
  978.      * that points to a destructed object. In that case, it has to
  979.      * be replaced by 0.
  980.      */
  981.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  982.         free_svalue(sp);
  983.         *sp = const0;
  984.     }
  985.     break;
  986.     CASE(F_PUSH_IDENTIFIER_LVALUE);
  987.     sp++;
  988.     sp->type = T_LVALUE;
  989.     sp->u.lvalue = find_value((int)(EXTRACT_UCHAR(pc) +
  990.                     variable_index_offset));
  991.     pc++;
  992.     break;
  993.     CASE(F_PUSH_INDEXED_LVALUE);
  994.     push_indexed_lvalue(1);
  995.     break;
  996.     CASE(F_INDEX);
  997.     push_indexed_lvalue(0);
  998.     assign_svalue_no_free(sp, sp->u.lvalue);
  999.     /*
  1000.      * Fetch value of a variable. It is possible that it is a variable
  1001.      * that points to a destructed object. In that case, it has to
  1002.      * be replaced by 0.
  1003.      */
  1004.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  1005.         free_svalue(sp);
  1006.         sp->type = T_NUMBER;
  1007.         sp->u.number = 0;
  1008.     }
  1009.     break;
  1010.     CASE(F_LOCAL_NAME);
  1011.     sp++;
  1012.     assign_svalue_no_free(sp, fp + EXTRACT_UCHAR(pc));
  1013.     pc++;
  1014.     /*
  1015.      * Fetch value of a variable. It is possible that it is a variable
  1016.      * that points to a destructed object. In that case, it has to
  1017.      * be replaced by 0.
  1018.      */
  1019.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  1020.         free_svalue(sp);
  1021.         *sp = const0;
  1022.     }
  1023.     break;
  1024.     CASE(F_PUSH_LOCAL_VARIABLE_LVALUE);
  1025.     sp++;
  1026.     sp->type = T_LVALUE;
  1027.     sp->u.lvalue = fp + EXTRACT_UCHAR(pc);
  1028.     pc++;
  1029.     break;
  1030.     CASE(F_RETURN);
  1031.     {
  1032.     struct svalue sv;
  1033.  
  1034.     sv = *sp--;
  1035.     /*
  1036.      * Deallocate frame and return.
  1037.      */
  1038.     for (i=0; i < csp->num_local_variables; i++)
  1039.         pop_stack();
  1040.     sp++;
  1041. #ifdef DEBUG
  1042.     if (sp != fp)
  1043.         fatal("Bad stack at F_RETURN\n"); /* marion */
  1044. #endif
  1045.     *sp = sv;    /* This way, the same ref counts are maintained */
  1046.     pop_control_stack();
  1047.     tracedepth--;
  1048.     if (TRACEP(TRACE_RETURN)) {
  1049.         do_trace("Return", "", "");
  1050.         if (TRACEHB) {
  1051.         if (TRACETST(TRACE_ARGS)) {
  1052.             add_message(" with value: ");
  1053.             print_svalue(sp);
  1054.         }
  1055.         add_message("\n");
  1056.         }
  1057.     }
  1058.     if (csp[1].extern_call)    /* The control stack was popped just before */
  1059.         return;
  1060.     break;
  1061.     }
  1062.     CASE(F_BREAK_POINT);
  1063.     break_point();    /* generated by lang.y when -d. Will check stack. */
  1064.     break;
  1065.     CASE(F_CLONE_OBJECT);
  1066.     ob = clone_object(sp->u.string);
  1067.     pop_stack();
  1068.     if (ob) {
  1069.         sp++;
  1070.         sp->type = T_OBJECT;
  1071.         sp->u.ob = ob;
  1072.         add_ref(ob, "F_CLONE_OBJECT");
  1073.     } else {
  1074.         push_number(0);
  1075.     }
  1076.     break;
  1077.     CASE(F_AGGREGATE);
  1078.     {
  1079.     struct vector *v;
  1080.     unsigned short num;
  1081.  
  1082.     ((char *)&num)[0] = pc[0];
  1083.     ((char *)&num)[1] = pc[1];
  1084.     pc += 2;
  1085.     v = allocate_array((int)num);
  1086.     for (i=0; i < num; i++)
  1087.         assign_svalue_no_free(&v->item[i], sp + i - num + 1);
  1088.     pop_n_elems((int)num);
  1089.     sp++;
  1090.     sp->type = T_POINTER;
  1091.     sp->u.vec = v;        /* Ref count already initialized */
  1092.     break;
  1093.     }
  1094.     CASE(F_M_AGGREGATE);
  1095.     {
  1096.     struct vector *v, *w;
  1097.     unsigned short num;
  1098.     struct svalue *arg;
  1099.  
  1100.     ((char *)&num)[0] = pc[0];
  1101.     ((char *)&num)[1] = pc[1];
  1102.     pc += 2;
  1103.     v = allocate_array(num / 2);
  1104.     w = allocate_array(num / 2);
  1105.     for (i=0; i < num; i += 2) {
  1106.         arg = sp + i - num;
  1107.         assign_svalue_no_free(&v->item[i / 2], arg + 1);
  1108.         assign_svalue_no_free(&w->item[i / 2], arg + 2);
  1109.     }
  1110.     pop_n_elems((int)num);
  1111.     sp++;
  1112.     v = allocate_mapping(v, w);
  1113.     sp->type = T_MAPPING;
  1114.     sp->u.vec = order_alist(v);
  1115.     free_mapping(v);
  1116.     break;
  1117.     }
  1118. #ifndef NLHACK
  1119.     CASE(F_TAIL);
  1120.     if (tail(sp->u.string))
  1121.         assign_svalue(sp, &const1);
  1122.     else
  1123.         assign_svalue(sp, &const0);
  1124.     break;
  1125. #endif
  1126.     CASE(F_CALL_FUNCTION_BY_ADDRESS);
  1127.     {
  1128.     unsigned short func_index;
  1129.     struct function *funp;
  1130.  
  1131.     ((char *)&func_index)[0] = pc[0];
  1132.     ((char *)&func_index)[1] = pc[1];
  1133.     pc += 2;
  1134.     func_index += function_index_offset;
  1135.     /*
  1136.      * Find the function in the function table. As the function may have
  1137.      * been redefined by inheritance, we must look in the last table,
  1138.      * which is pointed to by current_object.
  1139.      */
  1140. #ifdef DEBUG
  1141.     if (func_index >= current_object->prog->num_functions)
  1142.         fatal("Illegal function index\n");
  1143. #endif
  1144.  
  1145.     /* NOT current_prog, which can be an inherited object. */
  1146.     funp = ¤t_object->prog->functions[func_index];
  1147.     if (funp->flags & NAME_UNDEFINED)
  1148.         error("Undefined function: %s\n", funp->name);
  1149.     /* Save all important global stack machine registers */
  1150.     push_control_stack(funp);    /* return pc is adjusted later */
  1151.  
  1152.     /* This assigment must be done after push_control_stack() */
  1153.     current_prog = current_object->prog;
  1154.     /*
  1155.      * If it is an inherited function, search for the real
  1156.      * definition.
  1157.      */
  1158.     csp->num_local_variables = EXTRACT_UCHAR(pc);
  1159.     pc++;
  1160.     funp = setup_new_frame(funp);
  1161.     csp->pc = pc;    /* The corrected return address */
  1162.     pc = current_prog->program + funp->offset;
  1163.     csp->extern_call = 0;
  1164.     break;
  1165.     }
  1166.     CASE(F_SAVE_OBJECT);
  1167.     save_object(current_object, sp->u.string);
  1168.     /* The argument is returned */
  1169.     break;
  1170.     CASE(F_FIND_OBJECT);
  1171.     ob = find_object2(sp->u.string);
  1172.     pop_stack();
  1173.     if (ob)
  1174.         push_object(ob);
  1175.     else
  1176.         push_number(0);
  1177.     break;
  1178.     CASE(F_FIND_PLAYER);
  1179.     ob = find_living_object(sp->u.string, 1);
  1180.     pop_stack();
  1181.     if (!ob)
  1182.         push_number(0);
  1183.     else
  1184.         push_object(ob);
  1185.     break;
  1186. #ifndef NLHACK
  1187.     CASE(F_WRITE_FILE);
  1188.     i = write_file((sp-1)->u.string, sp->u.string);
  1189.     pop_n_elems(2);
  1190.     push_number(i);
  1191.     break;
  1192. #endif
  1193.     CASE(F_READ_FILE);
  1194.     {
  1195.     char *str;
  1196.     struct svalue *arg = sp- num_arg + 1;
  1197.     int start = 0, len = 0;
  1198.  
  1199.     if (num_arg > 1)
  1200.         start = arg[1].u.number;
  1201.     if (num_arg == 3) {
  1202.         if (arg[2].type != T_NUMBER)
  1203.         bad_arg(2, instruction);
  1204.         len = arg[2].u.number;
  1205.     }
  1206.  
  1207.     str = read_file(arg[0].u.string, start, len);
  1208.     pop_n_elems(num_arg);
  1209.     if (str == 0)
  1210.         push_number(0);
  1211.     else {
  1212.         push_string(str, STRING_MALLOC);
  1213.         xfree(str);
  1214.     }
  1215.     break;
  1216.     }
  1217.     CASE(F_READ_BYTES);
  1218.     {
  1219.     char *str;
  1220.  
  1221.     str = read_bytes((sp-2)->u.string, (sp-1)->u.number, sp->u.number);
  1222.     pop_n_elems(num_arg);
  1223.     if (str == 0)
  1224.         push_number(0);
  1225.     else {
  1226.         push_string(str, STRING_MALLOC);
  1227.         xfree(str);
  1228.     }
  1229.     break;
  1230.     }
  1231.     CASE(F_WRITE_BYTES);
  1232.     i = write_bytes((sp-2)->u.string, (sp-1)->u.number, sp->u.string);
  1233.     pop_n_elems(3);
  1234.     push_number(i);
  1235.     break;
  1236.     CASE(F_FILE_SIZE);
  1237.     i = file_size(sp->u.string);
  1238.     pop_stack();
  1239.     push_number(i);
  1240.     break;
  1241.     CASE(F_FIND_LIVING);
  1242.     ob = find_living_object(sp->u.string, 0);
  1243.     pop_stack();
  1244.     if (!ob)
  1245.         push_number(0);
  1246.     else
  1247.         push_object(ob);
  1248.     break;
  1249.     CASE(F_TELL_OBJECT);
  1250.     tell_object((sp-1)->u.ob, sp->u.string);
  1251.     pop_stack();    /* Return first argument */
  1252.     break;
  1253.     CASE(F_RESTORE_OBJECT);
  1254.     i = restore_object(current_object, sp->u.string);
  1255.     pop_stack();
  1256.     push_number(i);
  1257.     break;
  1258.     CASE(F_THIS_PLAYER);
  1259.     if (command_giver && !(command_giver->flags & O_DESTRUCTED))
  1260.         push_object(command_giver);
  1261.     else
  1262.         push_number(0);
  1263.     break;
  1264.     CASE(F_THIS_INTERACTIVE);
  1265.     if (current_interactive && !(current_interactive->flags&O_DESTRUCTED))
  1266.         push_object(current_interactive);
  1267.     else
  1268.         push_number(0);
  1269.     break;
  1270. #ifdef F_FIRST_INVENTORY
  1271.     CASE(F_FIRST_INVENTORY);
  1272.     ob = first_inventory(sp);
  1273.     pop_stack();
  1274.     if (ob)
  1275.         push_object(ob);
  1276.     else
  1277.         push_number(0);
  1278.     break;
  1279. #endif /* F_FIRST_INVENTORY */
  1280.     CASE(F_LIVING);
  1281.     if (sp->u.ob->flags & O_ENABLE_COMMANDS)
  1282.         assign_svalue(sp, &const1);
  1283.     else
  1284.         assign_svalue(sp, &const0);
  1285.     break;
  1286. #ifdef F_GETUID
  1287.     CASE(F_GETUID);
  1288.     /*
  1289.      * Are there any reasons to support this one in -o mode ?
  1290.      */
  1291.     ob = sp->u.ob;
  1292. #ifdef DEBUG
  1293.     if (ob->user == 0)
  1294.         fatal("User is null pointer\n");
  1295. #endif
  1296.     {   char *tmp;
  1297.         tmp = ob->user->name;
  1298.         pop_stack();
  1299.         push_string(tmp, STRING_CONSTANT);
  1300.     }
  1301.     break;
  1302. #endif /* F_GETUID */
  1303. #ifdef F_GETEUID
  1304.     CASE(F_GETEUID);
  1305.     /*
  1306.      * Are there any reasons to support this one in -o mode ?
  1307.      */
  1308.     ob = sp->u.ob;
  1309.  
  1310.     if (ob->eff_user) {
  1311.         char *tmp;
  1312.         tmp = ob->eff_user->name;
  1313.         pop_stack();
  1314.         push_string(tmp, STRING_CONSTANT);
  1315.     }
  1316.     else {
  1317.         pop_stack();
  1318.         push_number(0);
  1319.     }
  1320.     break;
  1321. #endif /* F_GETEUID */
  1322. #ifdef F_EXPORT_UID
  1323.     CASE(F_EXPORT_UID);
  1324.     if (current_object->eff_user == 0)
  1325.         error("Illegal to export uid 0\n");
  1326.     ob = sp->u.ob;
  1327.     if (ob->eff_user)    /* Only allowed to export when null */
  1328.         break;
  1329.     ob->user = current_object->eff_user;
  1330.     break;
  1331. #endif /* F_EXPORT_UID */
  1332. #ifdef F_SETEUID
  1333.     CASE(F_SETEUID);
  1334.     {
  1335.     struct svalue *ret;
  1336.  
  1337.     if (sp->type == T_NUMBER) {
  1338.         if (sp->u.number != 0)
  1339.         bad_arg(1, F_SETEUID);
  1340.         current_object->eff_user = 0;
  1341.         pop_stack();
  1342.         push_number(1);
  1343.         break;
  1344.     }
  1345.     argp = sp;
  1346.     if (argp->type != T_STRING)
  1347.         bad_arg(1, F_SETEUID);
  1348.     push_object(current_object);
  1349.     push_string(argp->u.string, STRING_CONSTANT);
  1350.     ret = apply_master_ob("valid_seteuid", 2);
  1351.     if (ret == 0 || ret->type != T_NUMBER || ret->u.number != 1) {
  1352.         pop_stack();
  1353.         push_number(0);
  1354.         break;
  1355.     }
  1356.     current_object->eff_user = add_name(argp->u.string);
  1357.     pop_stack();
  1358.     push_number(1);
  1359.     break;
  1360.     }
  1361. #endif /* F_SETEUID */
  1362. #ifdef F_SETUID
  1363.     CASE(F_SETUID)
  1364.     setuid();
  1365.     push_number(0);
  1366.     break;
  1367. #endif /* F_SETUID */
  1368. #ifdef F_CREATOR
  1369.     CASE(F_CREATOR);
  1370.     ob = sp->u.ob;
  1371.     if (ob->user == 0) {
  1372.         assign_svalue(sp, &const0);
  1373.     } else {
  1374.         pop_stack();
  1375.         push_string(ob->user->name, STRING_CONSTANT);
  1376.     }
  1377.     break;
  1378. #endif
  1379.     CASE(F_SHUTDOWN);
  1380. #if defined(NLHACK) && defined(COMPAT_MODE)
  1381.     if (strncmp(current_object->name, "obj/", 4))
  1382.         error("Illegal call to shutdown()\n");
  1383. #endif
  1384.     startshutdowngame();
  1385.     push_number(0);
  1386.     break;
  1387.     CASE(F_EXPLODE);
  1388.     {
  1389.     struct vector *v;
  1390.     v = explode_string((sp-1)->u.string, sp->u.string);
  1391.     pop_n_elems(2);
  1392.     if (v) {
  1393.         push_vector(v);    /* This will make ref count == 2 */
  1394.         v->ref--;
  1395.     } else {
  1396.         push_number(0);
  1397.     }
  1398.     break;
  1399.     }
  1400.     CASE(F_FILTER_ARRAY);
  1401.     {
  1402.     struct vector *v;
  1403.     struct svalue *arg;
  1404.  
  1405.     arg = sp - num_arg + 1; ob = 0;
  1406.  
  1407.     if (arg[2].type == T_OBJECT)
  1408.         ob = arg[2].u.ob;
  1409.     else if (arg[2].type == T_STRING) 
  1410.         ob = find_object(arg[2].u.string);
  1411.  
  1412.     if (!ob)
  1413.         error("Bad third argument to filter_array()\n");
  1414.  
  1415.     if (arg[0].type == T_POINTER) {
  1416.         check_for_destr(arg[0].u.vec);
  1417.         v = filter(arg[0].u.vec, arg[1].u.string, ob,
  1418.                num_arg > 3 ? sp : (struct svalue *)0); 
  1419.     } else {
  1420.         v = 0;
  1421.     }
  1422.     
  1423.     pop_n_elems(num_arg);
  1424.     if (v) {
  1425.         push_vector(v); /* This will make ref count == 2 */
  1426.         v->ref--;
  1427.     } else {
  1428.         push_number(0);
  1429.     }
  1430.     break;
  1431.     }
  1432.     CASE(F_FILTER_MAPPING);
  1433.     {
  1434.     struct vector *v;
  1435.     struct svalue *arg;
  1436.  
  1437.     arg = sp - num_arg + 1; ob = 0;
  1438.  
  1439.     if (arg[2].type == T_OBJECT)
  1440.         ob = arg[2].u.ob;
  1441.     else if (arg[2].type == T_STRING) 
  1442.         ob = find_object(arg[2].u.string);
  1443.  
  1444.     if (!ob)
  1445.         error("Bad third argument to filter_mapping()\n");
  1446.  
  1447.     if (arg[0].type == T_MAPPING) {
  1448.         check_map_for_destr(arg[0].u.vec);
  1449.         v = filter_mapping(arg[0].u.vec, arg[1].u.string, ob,
  1450.                    num_arg > 3 ? sp : (struct svalue *)0); 
  1451.     } else {
  1452.         v = 0;
  1453.     }
  1454.  
  1455.     pop_n_elems(num_arg);
  1456.     if (v) {
  1457.         push_mapping(v); /* This will make ref count == 2 */
  1458.         v->ref--;
  1459.     } else {
  1460.         push_number(0);
  1461.     }
  1462.     break;
  1463.     }
  1464.     CASE(F_SET_BIT);
  1465.     {
  1466.     char *str;
  1467.     int len, old_len, ind;
  1468.  
  1469.     if (sp->u.number > MAX_BITS)
  1470.         error("set_bit: too big bit number: %d\n", sp->u.number);
  1471.     len = strlen((sp-1)->u.string);
  1472.     old_len = len;
  1473.     ind = sp->u.number/6;
  1474.     if (ind >= len)
  1475.         len = ind + 1;
  1476.     str = xalloc(len+1);
  1477.     str[len] = '\0';
  1478.     if (old_len)
  1479.         memcpy(str, (sp-1)->u.string, old_len);
  1480.     if (len > old_len)
  1481.         memset(str + old_len, ' ', len - old_len);
  1482.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ') {
  1483.         xfree(str);
  1484.         error("Illegal bit pattern in set_bit character %d\n", ind);
  1485.     }
  1486.     str[ind] = (str[ind] - ' ' | 1 << sp->u.number % 6) + ' ';
  1487.     pop_n_elems(2);
  1488.     sp++;
  1489.     sp->u.string = str;
  1490.     sp->string_type = STRING_MALLOC;
  1491.     sp->type = T_STRING;
  1492.     break;
  1493.     }
  1494.     CASE(F_CLEAR_BIT);
  1495.     {
  1496.     char *str;
  1497.     int len, ind;
  1498.  
  1499.     if (sp->u.number > MAX_BITS)
  1500.         error("clear_bit: too big bit number: %d\n", sp->u.number);
  1501.     len = strlen((sp-1)->u.string);
  1502.     ind = sp->u.number/6;
  1503.     if (ind >= len) {
  1504.         /* Return first argument unmodified ! */
  1505.         pop_stack();
  1506.         break;
  1507.     }
  1508.     str = xalloc(len+1);
  1509.     memcpy(str, (sp-1)->u.string, len+1);    /* Including null byte */
  1510.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ') {
  1511.         xfree(str);
  1512.         error("Illegal bit pattern in clear_bit character %d\n", ind);
  1513.     }
  1514.     str[ind] = (str[ind] - ' ' & ~(1 << sp->u.number % 6)) + ' ';
  1515.     pop_n_elems(2);
  1516.     sp++;
  1517.     sp->type = T_STRING;
  1518.     sp->string_type = STRING_MALLOC;
  1519.     sp->u.string = str;
  1520.     break;
  1521.     }
  1522.     CASE(F_TEST_BIT);
  1523.     {
  1524.     int len;
  1525.  
  1526.     len = strlen((sp-1)->u.string);
  1527.     if (sp->u.number/6 >= len) {
  1528.         pop_n_elems(2);
  1529.         push_number(0);
  1530.         break;
  1531.     }
  1532.     if ((sp-1)->u.string[sp->u.number/6] - ' ' & 1 << sp->u.number % 6) {
  1533.         pop_n_elems(2);
  1534.         push_number(1);
  1535.     } else {
  1536.         pop_n_elems(2);
  1537.         push_number(0);
  1538.     }
  1539.     break;
  1540.     }
  1541.     CASE(F_QUERY_LOAD_AVERAGE);
  1542.     push_string(query_load_av(), STRING_MALLOC);
  1543.     break;
  1544.     CASE(F_CATCH);
  1545.     /*
  1546.      * Catch/Throw - catch errors in system or other peoples routines.
  1547.      */
  1548.     {
  1549.     extern jmp_buf error_recovery_context;
  1550.     extern int error_recovery_context_exists;
  1551.     extern struct svalue catch_value;
  1552.     unsigned short new_pc_offset;
  1553.  
  1554.     /*
  1555.      * Compute address of next instruction after the CATCH statement.
  1556.      */
  1557.     ((char *)&new_pc_offset)[0] = pc[0];
  1558.     ((char *)&new_pc_offset)[1] = pc[1];
  1559.     pc += 2;
  1560.  
  1561.     push_control_stack(0);
  1562.     csp->num_local_variables = 0;    /* No extra variables */
  1563.     csp->pc = current_prog->program + new_pc_offset;
  1564.     csp->num_local_variables = (csp-1)->num_local_variables; /* marion */
  1565.     /*
  1566.      * Save some global variables that must be restored separately
  1567.      * after a longjmp. The stack will have to be manually popped all
  1568.      * the way.
  1569.      */
  1570.     push_pop_error_context (1);
  1571.     
  1572.     /* signal catch OK - print no err msg */
  1573.        error_recovery_context_exists = 2;
  1574.     if (setjmp(error_recovery_context)) {
  1575.         /*
  1576.          * They did a throw() or error. That means that the control
  1577.          * stack must be restored manually here.
  1578.          * Restore the value of expected_stack also. It is always 0
  1579.          * for catch().
  1580.          */
  1581.         expected_stack = 0;
  1582.         push_pop_error_context (-1);
  1583.         pop_control_stack();
  1584.         assign_svalue_no_free(++sp, &catch_value);
  1585.     }
  1586.  
  1587.     /* next error will return 1 by default */
  1588.     assign_svalue(&catch_value, &const1);
  1589.     break;
  1590.     }
  1591.     CASE(F_THROW);
  1592.     /* marion
  1593.      * the return from catch is now done by a 0 throw
  1594.      */
  1595.     assign_svalue(&catch_value, sp--);
  1596.     if (catch_value.type == T_NUMBER && catch_value.u.number == 0) {
  1597.         /* We come here when no longjmp() was executed. */
  1598.         pop_control_stack();
  1599.         push_pop_error_context (0);
  1600.         push_number(0);
  1601.     } else throw_error(); /* do the longjump, with extra checks... */
  1602.     break;
  1603.     CASE(F_NOTIFY_FAIL);
  1604.     set_notify_fail_message(sp->u.string);
  1605.     /* Return the argument */
  1606.     break;
  1607.     CASE(F_QUERY_IDLE);
  1608.     i = query_idle(sp->u.ob);
  1609.     pop_stack();
  1610.     push_number(i);
  1611.     break;
  1612.     CASE(F_INTERACTIVE);
  1613.         i = (int)sp->u.ob->interactive;
  1614.     pop_stack();
  1615.     push_number(i);
  1616.     break;
  1617.     CASE(F_IMPLODE);
  1618.     {
  1619.     char *str;
  1620.     check_for_destr((sp-1)->u.vec);
  1621.     str = implode_string((sp-1)->u.vec, sp->u.string);
  1622.     pop_n_elems(2);
  1623.     if (str) {
  1624.         sp++;
  1625.         sp->type = T_STRING;
  1626.         sp->string_type = STRING_MALLOC;
  1627.         sp->u.string = str;
  1628.     } else {
  1629.         push_number(0);
  1630.     }
  1631.     break;
  1632.     }
  1633.     CASE(F_QUERY_SNOOP);
  1634.     {
  1635. #ifdef COMPAT_MODE
  1636. #ifdef NLHACK
  1637.     struct object *caller;
  1638. #else
  1639.     struct svalue *arg1;
  1640. #endif
  1641. #endif
  1642.  
  1643.     if (command_giver == 0 || sp->u.ob->interactive == 0 || (command_giver->flags & O_DESTRUCTED)) {
  1644.         assign_svalue(sp, &const0);
  1645.         break;
  1646.     }
  1647. #ifdef COMPAT_MODE
  1648. #ifdef NLHACK
  1649.     /*
  1650.      * Paranoid security version
  1651.      */
  1652.     if (!command_giver->interactive) {
  1653.         assign_svalue(sp, &const0);
  1654.         break;
  1655.     }
  1656.     /*
  1657.      * Not a beauty..
  1658.      */
  1659.     if (!strcmp(current_object->name, SIMUL_EFUN))
  1660.         caller = previous_ob;
  1661.     else {
  1662.         /*
  1663.          * Yuck! I really should find a better solution for this.. Zappa
  1664.          *
  1665.          */
  1666.         error("Illegal efun:: prefix on query_snoop()\n");
  1667.     }
  1668.     if (command_giver != caller) {
  1669.         if (!command_giver->living_name || !caller->eff_user ||
  1670.           strcmp(command_giver->living_name, (char *) caller->eff_user)) {
  1671.         assign_svalue(sp, &const0);
  1672.         break;
  1673.         }
  1674.     }
  1675.     ob = query_snoop(sp->u.ob);
  1676. #else
  1677.     arg1 = sapply("query_level", command_giver, 0);
  1678.     if (arg1 == 0 || arg1->type != T_NUMBER || arg1->u.number < 22) {
  1679.         assign_svalue(sp, &const0);
  1680.         break;
  1681.     }
  1682.     ob = query_snoop(sp->u.ob);
  1683. #endif
  1684. #else
  1685.     assert_master_ob_loaded();
  1686.     if (current_object == master_ob)
  1687.         ob = query_snoop(sp->u.ob);
  1688.     else
  1689.         ob = 0;
  1690. #endif
  1691.     pop_stack();
  1692.     if (ob)
  1693.         push_object(ob);
  1694.     else
  1695.         push_number(0);
  1696.     break;
  1697.     }
  1698.     CASE(F_QUERY_IP_NUMBER);
  1699.     CASE(F_QUERY_IP_NAME);
  1700.     {
  1701.     extern char *query_ip_number PROT((struct object *));
  1702.      extern char *query_ip_name PROT((struct object *));
  1703.     char *tmp;
  1704.  
  1705.     if (num_arg == 1 && sp->type != T_OBJECT)
  1706.         error("Bad optional argument to query_ip_number()\n");
  1707.     if (instruction == F_QUERY_IP_NAME)
  1708.         tmp = query_ip_name(num_arg ? sp->u.ob : 0);
  1709.     else
  1710.         tmp = query_ip_number(num_arg ? sp->u.ob : 0);
  1711.     if (num_arg)
  1712.         pop_stack();
  1713.     if (tmp == 0)
  1714.         push_number(0);
  1715.     else
  1716.         push_string(tmp, STRING_MALLOC);
  1717.     break;
  1718.     }
  1719.     CASE(F_QUERY_HOST_NAME);
  1720.     {
  1721.     extern char *query_host_name();
  1722.     char *tmp;
  1723.  
  1724.     tmp = query_host_name();
  1725.     if (tmp)
  1726.         push_string(tmp, STRING_CONSTANT);
  1727.     else
  1728.         push_number(0);
  1729.     break;
  1730.     }
  1731. #ifdef F_NEXT_INVENTORY
  1732.     CASE(F_NEXT_INVENTORY);
  1733.     {
  1734. #ifdef NLHACK
  1735.     int invis;
  1736. #endif
  1737.     ob = sp->u.ob;
  1738.     pop_stack();
  1739. #ifdef NLHACK
  1740.     invis = !command_giver || !(command_giver->flags & O_CAN_SEE_HINVIS);
  1741.     do {
  1742.         ob = ob->next_inv;
  1743.     } while (ob && invis && (ob->flags & O_HARD_INVIS));
  1744.     if (!ob)
  1745.         push_number(0);
  1746.     else
  1747.         push_object(ob);
  1748. #else
  1749.     if (ob->next_inv)
  1750.         push_object(ob->next_inv);
  1751.     else
  1752.         push_number(0);
  1753. #endif
  1754.     break;
  1755. #endif /* F_NEXT_INVENTORY */
  1756.     }
  1757.     CASE(F_ALL_INVENTORY);
  1758.     {
  1759.     struct vector *vec;
  1760.     vec = all_inventory(sp->u.ob);
  1761.     pop_stack();
  1762.     if (vec == 0) {
  1763.         push_number(0);
  1764.     } else {
  1765.         push_vector(vec); /* This will make ref count == 2 */
  1766.         vec->ref--;
  1767.     }
  1768.     break;
  1769.     }
  1770.     CASE(F_DEEP_INVENTORY);
  1771.     {
  1772.     struct vector *vec;
  1773.  
  1774.     vec = deep_inventory(sp->u.ob, 0);
  1775.     free_svalue(sp);
  1776.     sp->type = T_POINTER;
  1777.     sp->u.vec = vec;
  1778.     break;
  1779.     }
  1780.     CASE(F_ENVIRONMENT);
  1781.     if (num_arg) {
  1782.         ob = environment(sp);
  1783.         pop_stack();
  1784.     } else if (!(current_object->flags & O_DESTRUCTED)) {
  1785.         ob = current_object->super;
  1786.     } else
  1787.         ob = 0;
  1788.     if (ob)
  1789.         push_object(ob);
  1790.     else
  1791.         push_number(0);
  1792.     break;
  1793.     CASE(F_THIS_OBJECT);
  1794.     if (current_object->flags & O_DESTRUCTED)
  1795.         push_number(0);
  1796.     else
  1797.         push_object(current_object);
  1798.     break;
  1799.     CASE(F_PREVIOUS_OBJECT);
  1800.     if (previous_ob == 0 || (previous_ob->flags & O_DESTRUCTED))
  1801.         push_number(0);
  1802.     else
  1803.         push_object(previous_ob);
  1804.     break;
  1805.     CASE(F_MASTER_OBJECT);
  1806.     assert_master_ob_loaded();
  1807.     push_object(master_ob);
  1808.     break;
  1809. #ifdef F_LOCALCMD
  1810.     CASE(F_LOCALCMD);
  1811.     print_local_commands();
  1812.     push_number(0);
  1813.     break;
  1814. #endif /* F_LOCALCMD */
  1815.     CASE(F_SWAP);
  1816.     (void)swap(sp->u.ob);
  1817.     break;
  1818.     CASE(F_TRACE);
  1819.     {
  1820.         int ot = -1;
  1821.         if (command_giver && command_giver->interactive) {
  1822.         struct svalue *arg;
  1823.         push_constant_string("trace");
  1824.         arg = apply_master_ob("query_player_level", 1);
  1825.         if (arg && (arg->type != T_NUMBER || arg->u.number != 0)) {
  1826.             ot = command_giver->interactive->trace_level;
  1827.             command_giver->interactive->trace_level = sp->u.number;
  1828.         }
  1829.         }
  1830.         pop_stack();
  1831.         push_number(ot);
  1832.     }
  1833.     break;
  1834.     CASE(F_TRACEPREFIX);
  1835.     {
  1836.         char *old = 0;
  1837.  
  1838.         if (command_giver && command_giver->interactive) {
  1839.         struct svalue *arg;
  1840.         push_constant_string("trace");
  1841.         arg = apply_master_ob("query_player_level",1);
  1842.         if (arg && (arg->type != T_NUMBER || arg->u.number)) {
  1843.             old = command_giver->interactive->trace_prefix;
  1844.             if (sp->type == T_STRING) {
  1845.                 command_giver->interactive->trace_prefix = 
  1846.                 make_shared_string(sp->u.string);
  1847.                     } else
  1848.                 command_giver->interactive->trace_prefix = 0;
  1849.         }
  1850.         }
  1851.         pop_stack();
  1852.         if (old) {
  1853.         push_string(old, STRING_SHARED);   /* Will incr ref count */
  1854.         free_string(old);
  1855.         } else {
  1856.         push_number(0);
  1857.         }
  1858.     }
  1859.     break;
  1860.     CASE(F_TIME);
  1861.     push_number(current_time);
  1862.     break;
  1863.     CASE(F_WIZLIST);
  1864.     if (num_arg) {
  1865.         wizlist(sp->u.string);
  1866.     } else {
  1867.         wizlist(0);
  1868.         push_number(0);
  1869.     }
  1870.     break;
  1871. #ifdef F_TRANSFER
  1872.     CASE(F_TRANSFER);
  1873.     {
  1874.     struct object *dest;
  1875.  
  1876.     if (sp->type == T_STRING) {
  1877.         dest = find_object(sp->u.string);
  1878.         if (dest == 0)
  1879.         error("Object not found.\n");
  1880.     } else {
  1881.         dest = sp->u.ob;
  1882.     }
  1883.     i = transfer_object((sp-1)->u.ob, dest);
  1884.     pop_n_elems(2);
  1885.     push_number(i);
  1886.     break;
  1887.     }
  1888. #endif
  1889. #ifdef F_ADD_WORTH
  1890.     CASE(F_ADD_WORTH);
  1891.     if (strncmp(current_object->name, "obj/", 4) != 0 &&
  1892.         strncmp(current_object->name, "std/", 4) != 0 &&
  1893.         strncmp(current_object->name, "room/", 5) != 0)
  1894.         error("Illegal call of add_worth.\n");
  1895.     if (num_arg == 2) {
  1896.         if (sp->u.ob->user)
  1897.         sp->u.ob->user->total_worth += (sp-1)->u.number;
  1898.         pop_stack();
  1899.     } else {
  1900.         if (previous_ob == 0)
  1901.         break;
  1902.         if (previous_ob->user)
  1903.         previous_ob->user->total_worth += sp->u.number;
  1904.     }
  1905.     break;
  1906. #endif /* F_ADD_WORTH */
  1907.     CASE(F_ADD);
  1908. /*if (inadd==0) checkplus(p);*/
  1909.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1910.         char *res;
  1911.         int l = strlen((sp-1)->u.string);
  1912. #if defined(NLHACK)
  1913.         int l2 = strlen(sp->u.string);
  1914.  
  1915.         check_string_lengths(l, l2);
  1916.         res = xalloc(l + l2 + 1);
  1917. #else
  1918.         res = xalloc(l + strlen(sp->u.string) + 1);
  1919. #endif
  1920.         (void)strcpy(res, (sp-1)->u.string);
  1921.         (void)strcpy(res+l, sp->u.string);
  1922.         pop_n_elems(2);
  1923.         push_malloced_string(res);
  1924.     } else if ((sp-1)->type == T_NUMBER && sp->type == T_STRING) {
  1925. #if defined(NLHACK)
  1926.         char buff[20], *res;
  1927.         int l, l2 = strlen(sp->u.string);
  1928.  
  1929.         sprintf(buff, "%d", (sp-1)->u.number);
  1930.         l = strlen(buff);
  1931.         check_string_lengths(l, l2);
  1932.         res = xalloc(l + l2 + 1);
  1933. #else
  1934.         char buff[20], *res;
  1935.         sprintf(buff, "%d", (sp-1)->u.number);
  1936.         res = xalloc(strlen(sp->u.string) + strlen(buff) + 1);
  1937. #endif
  1938.         strcpy(res, buff);
  1939.         strcat(res, sp->u.string);
  1940.         pop_n_elems(2);
  1941.         push_malloced_string(res);
  1942.     } else if (sp->type == T_NUMBER && (sp-1)->type == T_STRING) {
  1943.         char buff[20];
  1944.         char *res;
  1945. #ifdef NLHACK
  1946.         int l1, l2;
  1947.         sprintf(buff, "%d", sp->u.number);
  1948.         l1 = strlen(buff);
  1949.         l2 = strlen((sp-1)->u.string);
  1950.         check_string_lengths(l1, l2);
  1951.         res = xalloc(l1 + l2 + 1);
  1952. #else
  1953.         sprintf(buff, "%d", sp->u.number);
  1954.         res = xalloc(strlen((sp-1)->u.string) + strlen(buff) + 1);
  1955. #endif
  1956.         strcpy(res, (sp-1)->u.string);
  1957.         strcat(res, buff);
  1958.         pop_n_elems(2);
  1959.         push_malloced_string(res);
  1960.     } else if ((sp-1)->type == T_NUMBER && sp->type == T_NUMBER) {
  1961.         i = sp->u.number + (sp-1)->u.number;
  1962.         sp--;
  1963.         sp->u.number = i;
  1964.     } else if ((sp-1)->type == T_POINTER && sp->type == T_POINTER) {
  1965.         struct vector *v;
  1966.         check_for_destr((sp-1)->u.vec);
  1967.         check_for_destr(sp->u.vec);
  1968.         v = add_array((sp-1)->u.vec,sp->u.vec);
  1969.         pop_n_elems(2);
  1970.         push_vector(v); /* This will make ref count == 2 */
  1971.         v->ref--;
  1972.     } else if ((sp-1)->type == T_MAPPING && sp->type == T_MAPPING) {
  1973.         struct vector *v;
  1974.         check_map_for_destr((sp-1)->u.vec);
  1975.         check_map_for_destr(sp->u.vec);
  1976.         v = add_mapping((sp-1)->u.vec,sp->u.vec);
  1977.         pop_n_elems(2);
  1978.         push_mapping(v); /* This will make ref count == 2 */
  1979.         v->ref--;
  1980.     } else {
  1981.         error("Bad type of arg to '+'\n");
  1982.     }
  1983.     break;
  1984.     CASE(F_SUBTRACT);
  1985.     if ((sp-1)->type == T_POINTER && sp->type == T_POINTER) {
  1986.         extern struct vector *subtract_array
  1987.           PROT((struct vector *,struct vector*));
  1988.         struct vector *v;
  1989.  
  1990.         v = sp->u.vec;
  1991.         if (v->ref > 1) {
  1992.         v = slice_array(v, 0, v->size-1 );
  1993.         v->ref--;
  1994.             }
  1995.         sp--;
  1996.         /* subtract_array already takes care of destructed objects */
  1997.         v = subtract_array(sp->u.vec, v);
  1998.         free_vector(sp->u.vec);
  1999.         sp->u.vec = v;
  2000.         break;
  2001.     }
  2002.     if ((sp-1)->type != T_NUMBER)
  2003.         bad_arg(1, F_SUBTRACT);
  2004.     if (sp->type != T_NUMBER)
  2005.         bad_arg(2, F_SUBTRACT);
  2006.     i = (sp-1)->u.number - sp->u.number;
  2007.     sp--;
  2008.     sp->u.number = i;
  2009.     break;
  2010.     CASE(F_AND);
  2011.     if (sp->type == T_POINTER && (sp-1)->type == T_POINTER) {
  2012.         extern struct vector *intersect_array
  2013.           PROT((struct vector *, struct vector *));
  2014.         (sp-1)->u.vec = intersect_array(sp->u.vec, (sp-1)->u.vec);
  2015.         sp--;
  2016.         break;
  2017.     }
  2018.     if ((sp-1)->type != T_NUMBER)
  2019.         bad_arg(1, F_AND);
  2020.     if (sp->type != T_NUMBER)
  2021.         bad_arg(2, F_AND);
  2022.     i = (sp-1)->u.number & sp->u.number;
  2023.     sp--;
  2024.     sp->u.number = i;
  2025.     break;
  2026.     CASE(F_OR);
  2027.     if ((sp-1)->type != T_NUMBER)
  2028.         bad_arg(1, F_OR);
  2029.     if (sp->type != T_NUMBER)
  2030.         bad_arg(2, F_OR);
  2031.     i = (sp-1)->u.number | sp->u.number;
  2032.     sp--;
  2033.     sp->u.number = i;
  2034.     break;
  2035.     CASE(F_XOR);
  2036.     if ((sp-1)->type != T_NUMBER)
  2037.         bad_arg(1, instruction);
  2038.     if (sp->type != T_NUMBER)
  2039.         bad_arg(2, instruction);
  2040.     i = (sp-1)->u.number ^ sp->u.number;
  2041.     sp--;
  2042.     sp->u.number = i;
  2043.     break;
  2044.     CASE(F_LSH);
  2045.     if ((sp-1)->type != T_NUMBER)
  2046.         bad_arg(1, instruction);
  2047.     if (sp->type != T_NUMBER)
  2048.         bad_arg(2, instruction);
  2049.     i = (sp-1)->u.number << sp->u.number;
  2050.     sp--;
  2051.     sp->u.number = i;
  2052.     break;
  2053.     CASE(F_RSH);
  2054.     if ((sp-1)->type != T_NUMBER)
  2055.         bad_arg(1, instruction);
  2056.     if (sp->type != T_NUMBER)
  2057.         bad_arg(2, instruction);
  2058.     i = (sp-1)->u.number >> sp->u.number;
  2059.     sp--;
  2060.     sp->u.number = i;
  2061.     break;
  2062.     CASE(F_MULTIPLY);
  2063.     if ((sp-1)->type != T_NUMBER)
  2064.         bad_arg(1, instruction);
  2065.     if (sp->type != T_NUMBER)
  2066.         bad_arg(2, instruction);
  2067.     i = (sp-1)->u.number * sp->u.number;
  2068.     sp--;
  2069.     sp->u.number = i;
  2070.     break;
  2071.     CASE(F_DIVIDE);
  2072.     if ((sp-1)->type != T_NUMBER)
  2073.         bad_arg(1, instruction);
  2074.     if (sp->type != T_NUMBER)
  2075.         bad_arg(2, instruction);
  2076.     if (sp->u.number == 0)
  2077.         error("Division by zero\n");
  2078.     i = (sp-1)->u.number / sp->u.number;
  2079.     sp--;
  2080.     sp->u.number = i;
  2081.     break;
  2082.     CASE(F_MOD);
  2083.     if ((sp-1)->type != T_NUMBER)
  2084.         bad_arg(1, instruction);
  2085.     if (sp->type != T_NUMBER)
  2086.         bad_arg(2, instruction);
  2087.     if (sp->u.number == 0)
  2088.         error("Modulus by zero.\n");
  2089.     i = (sp-1)->u.number % sp->u.number;
  2090.     sp--;
  2091.     sp->u.number = i;
  2092.     break;
  2093.     CASE(F_GT);
  2094.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2095.         i = strcmp((sp-1)->u.string, sp->u.string) > 0;
  2096.         pop_n_elems(2);
  2097.         push_number(i);
  2098.         break;
  2099.     }
  2100.     if ((sp-1)->type != T_NUMBER)
  2101.         bad_arg(1, instruction);
  2102.     if (sp->type != T_NUMBER)
  2103.         bad_arg(2, instruction);
  2104.     i = (sp-1)->u.number > sp->u.number;
  2105.     sp--;
  2106.     sp->u.number = i;
  2107.     break;
  2108.     CASE(F_GE);
  2109.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2110.         i = strcmp((sp-1)->u.string, sp->u.string) >= 0;
  2111.         pop_n_elems(2);
  2112.         push_number(i);
  2113.         break;
  2114.     }
  2115.     if ((sp-1)->type != T_NUMBER)
  2116.         bad_arg(1, instruction);
  2117.     if (sp->type != T_NUMBER)
  2118.         bad_arg(2, instruction);
  2119.     i = (sp-1)->u.number >= sp->u.number;
  2120.     sp--;
  2121.     sp->u.number = i;
  2122.     break;
  2123.     CASE(F_LT);
  2124.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2125.         i = strcmp((sp-1)->u.string, sp->u.string) < 0;
  2126.         pop_n_elems(2);
  2127.         push_number(i);
  2128.         break;
  2129.     }
  2130.     if ((sp-1)->type != T_NUMBER)
  2131.         bad_arg(1, instruction);
  2132.     if (sp->type != T_NUMBER)
  2133.         bad_arg(2, instruction);
  2134.     i = (sp-1)->u.number < sp->u.number;
  2135.     sp--;
  2136.     sp->u.number = i;
  2137.     break;
  2138.     CASE(F_LE);
  2139.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2140.         i = strcmp((sp-1)->u.string, sp->u.string) <= 0;
  2141.         pop_n_elems(2);
  2142.         push_number(i);
  2143.         break;
  2144.     }
  2145.     if ((sp-1)->type != T_NUMBER)
  2146.         bad_arg(1, instruction);
  2147.     if (sp->type != T_NUMBER)
  2148.         bad_arg(2, instruction);
  2149.     i = (sp-1)->u.number <= sp->u.number;
  2150.     sp--;
  2151.     sp->u.number = i;
  2152.     break;
  2153.     CASE(F_EQ);
  2154.     if ((sp-1)->type != sp->type) {
  2155.         pop_stack();
  2156.         assign_svalue(sp, &const0);
  2157.         break;
  2158.     }
  2159.     switch(sp->type) {
  2160.     case T_NUMBER:
  2161.         i = (sp-1)->u.number == sp->u.number;
  2162.         break;
  2163.     case T_POINTER:
  2164.         i = (sp-1)->u.vec == sp->u.vec;
  2165.         break;
  2166.     case T_MAPPING:
  2167.         i = ((sp-1)->u.vec == sp->u.vec) ||
  2168.         (sp->u.vec->item[0].u.vec->size == 0 &&
  2169.          (sp-1)->u.vec->item[0].u.vec->size == 0);
  2170.         break;
  2171.     case T_STRING:
  2172.         i = strcmp((sp-1)->u.string, sp->u.string) == 0;
  2173.         break;
  2174.     case T_OBJECT:
  2175.         i = (sp-1)->u.ob == sp->u.ob;
  2176.         break;
  2177.     default:
  2178.         i = 0;
  2179.         break;
  2180.     }
  2181.     pop_n_elems(2);
  2182.     push_number(i);
  2183.     break;
  2184.     CASE(F_NE);
  2185.     if ((sp-1)->type != sp->type) {
  2186.         pop_stack();
  2187.         assign_svalue(sp, &const1);
  2188.         break;
  2189.     }
  2190.     switch(sp->type) {
  2191.     case T_NUMBER:
  2192.         i = (sp-1)->u.number != sp->u.number;
  2193.         break;
  2194.     case T_STRING:
  2195.         i = strcmp((sp-1)->u.string, sp->u.string);
  2196.         break;
  2197.     case T_POINTER:
  2198.         i = (sp-1)->u.vec != sp->u.vec;
  2199.         break;
  2200.     case T_MAPPING:
  2201.         i = ((sp-1)->u.vec != sp->u.vec) &&
  2202.         (sp->u.vec->item[0].u.vec->size != 0 ||
  2203.          (sp-1)->u.vec->item[0].u.vec->size != 0);
  2204.         break;
  2205.     case T_OBJECT:
  2206.         i = (sp-1)->u.ob != sp->u.ob;
  2207.         break;
  2208.     default:
  2209.         fatal("Illegal type to !=\n");
  2210.     }
  2211.     pop_n_elems(2);
  2212.     push_number(i);
  2213.     break;
  2214. #ifdef F_LOG_FILE
  2215.     CASE(F_LOG_FILE);
  2216.     log_file((sp-1)->u.string, sp->u.string);
  2217.     pop_stack();
  2218.     break;    /* Return first argument */
  2219. #endif /* F_LOG_FILE */
  2220.     CASE(F_NOT);
  2221.     if (sp->type == T_NUMBER && sp->u.number == 0)
  2222.         sp->u.number = 1;
  2223.     else
  2224.         assign_svalue(sp, &const0);
  2225.     break;
  2226.     CASE(F_COMPL);
  2227.     if (sp->type != T_NUMBER)
  2228.         error("Bad argument to ~\n");
  2229.     sp->u.number = ~ sp->u.number;
  2230.     break;
  2231.     CASE(F_NEGATE);
  2232.     if (sp->type != T_NUMBER)
  2233.         error("Bad argument to unary minus\n");
  2234.     sp->u.number = - sp->u.number;
  2235.     break;
  2236.     CASE(F_INC);
  2237.     if (sp->type != T_LVALUE)
  2238.         error("Bad argument to ++\n");
  2239.     if (sp->u.lvalue->type != T_NUMBER)
  2240.         error("++ of non-numeric argument\n");
  2241.     sp->u.lvalue->u.number++;
  2242.     assign_svalue(sp, sp->u.lvalue);
  2243.     break;
  2244.     CASE(F_DEC);
  2245.     if (sp->type != T_LVALUE)
  2246.         error("Bad argument to --\n");
  2247.     if (sp->u.lvalue->type != T_NUMBER)
  2248.         error("-- of non-numeric argument\n");
  2249.     sp->u.lvalue->u.number--;
  2250.     assign_svalue(sp, sp->u.lvalue);
  2251.     break;
  2252.     CASE(F_POST_INC);
  2253.     if (sp->type != T_LVALUE)
  2254.         error("Bad argument to ++\n");
  2255.     if (sp->u.lvalue->type != T_NUMBER)
  2256.         error("++ of non-numeric argument\n");
  2257.     sp->u.lvalue->u.number++;
  2258.     assign_svalue(sp, sp->u.lvalue);
  2259.     sp->u.number--;
  2260.     break;
  2261.     CASE(F_POST_DEC);
  2262.     if (sp->type != T_LVALUE)
  2263.         error("Bad argument to --\n");
  2264.     if (sp->u.lvalue->type != T_NUMBER)
  2265.         error("-- of non-numeric argument\n");
  2266.     sp->u.lvalue->u.number--;
  2267.     assign_svalue(sp, sp->u.lvalue);
  2268.     sp->u.number++;
  2269.     break;
  2270.     CASE(F_CALL_OTHER);
  2271.     {
  2272.     struct svalue *arg, tmp;
  2273.  
  2274. #ifdef CACHE_CALL_OTHER
  2275.     short func_index;
  2276.     char *cache_ix;
  2277.  
  2278.     cache_ix = (char *)pc;                   /* Where to put ix later */
  2279.     ((char *)&func_index)[0] = cache_ix[0];
  2280.     ((char *)&func_index)[1] = cache_ix[1];
  2281.     pc += 2; 
  2282. #endif
  2283.  
  2284.     arg = sp - num_arg + 1;
  2285.     if (arg[0].type == T_OBJECT)
  2286.         ob = arg[0].u.ob;
  2287.     else {
  2288.         ob = find_object(arg[0].u.string);
  2289.         if (ob == 0)
  2290.         error("call_other() failed\n");
  2291.     }
  2292.     if (current_object->flags & O_DESTRUCTED) {
  2293.         /*
  2294.          * No external calls may be done when this object is
  2295.          * destructed.
  2296.          */
  2297.         pop_n_elems(num_arg);
  2298.         push_number(0);
  2299.         break;
  2300.     }
  2301.     if (arg[1].u.string[0] == ':')
  2302.         error("Illegal function name in call_other: %s\n",
  2303.           arg[1].u.string);
  2304.     /*
  2305.      * Send the remaining arguments to the function.
  2306.      */
  2307.     if (TRACEP(TRACE_CALL_OTHER)) {
  2308.         do_trace("Call other ", arg[1].u.string, "\n");
  2309.     }
  2310.  
  2311. #ifdef CACHE_CALL_OTHER
  2312.     if (apply_low(arg[1].u.string, ob, num_arg-2, &func_index) == 0) 
  2313.     {
  2314.         /* Function not found */
  2315.         pop_n_elems(2);
  2316.         push_number(0);
  2317.         break;
  2318.     }
  2319.     else
  2320.     {
  2321.         cache_ix[0] = ((char *)&func_index)[0];
  2322.         cache_ix[1] = ((char *)&func_index)[1];
  2323.         }
  2324. #else
  2325.     if (apply_low(arg[1].u.string, ob, num_arg-2) == 0) {
  2326.         /* Function not found */
  2327.         pop_n_elems(2);
  2328.         push_number(0);
  2329.         break;
  2330.     }
  2331. #endif
  2332.     /*
  2333.      * The result of the function call is on the stack. But, so
  2334.      * is the function name and object that was called.
  2335.      * These have to be removed.
  2336.      */
  2337.     tmp = *sp--;    /* Copy the function call result */
  2338.     pop_n_elems(2);    /* Remove old arguments to call_other */
  2339.     *++sp = tmp;    /* Re-insert function result */
  2340.     break;
  2341.     }
  2342.     CASE(F_INTP);
  2343.     if (sp->type == T_NUMBER)
  2344.         assign_svalue(sp, &const1);
  2345.     else
  2346.         assign_svalue(sp, &const0);
  2347.     break;
  2348.     CASE(F_STRINGP);
  2349.     if (sp->type == T_STRING)
  2350.         assign_svalue(sp, &const1);
  2351.     else
  2352.         assign_svalue(sp, &const0);
  2353.     break;
  2354.     CASE(F_OBJECTP);
  2355.     if (sp->type == T_OBJECT)
  2356.         assign_svalue(sp, &const1);
  2357.     else
  2358.         assign_svalue(sp, &const0);
  2359.     break;
  2360.     CASE(F_POINTERP);
  2361.     if (sp->type == T_POINTER)
  2362.         assign_svalue(sp, &const1);
  2363.     else
  2364.         assign_svalue(sp, &const0);
  2365.     break;
  2366.     CASE(F_MAPPINGP);
  2367.     if (sp->type == T_MAPPING)
  2368.         assign_svalue(sp, &const1);
  2369.     else
  2370.         assign_svalue(sp, &const0);
  2371.     break;
  2372.     CASE(F_EXTRACT);
  2373.     {
  2374.     int len, from, to;
  2375.     struct svalue *arg;
  2376.     char *res;
  2377.  
  2378.     arg = sp - num_arg + 1;
  2379.     len = strlen(arg[0].u.string);
  2380.     if (num_arg == 1)
  2381.         break;        /* Simply return argument */
  2382.     from = arg[1].u.number;
  2383.     if (from < 0)
  2384.         from = len + from;
  2385.     if (from >= len) {
  2386.         pop_n_elems(num_arg);
  2387.         push_string("", STRING_CONSTANT);
  2388.         break;
  2389.     }
  2390.     if (num_arg == 2) {
  2391.         res = string_copy(arg->u.string + from);
  2392.         pop_n_elems(2);
  2393.         push_malloced_string(res);
  2394.         break;
  2395.     }
  2396.     if (arg[2].type != T_NUMBER)
  2397.         error("Bad third argument to extract()\n");
  2398.     to = arg[2].u.number;
  2399.     if (to < 0)
  2400.         to = len + to;
  2401.     if (to < from) {
  2402.         pop_n_elems(3);
  2403.         push_string("", STRING_CONSTANT);
  2404.         break;
  2405.     }
  2406.     if (to >= len)
  2407.         to = len-1;
  2408.     if (to == len-1) {
  2409.         res = string_copy(arg->u.string + from);
  2410.         pop_n_elems(3);
  2411.         push_malloced_string(res);
  2412.         break;
  2413.     }
  2414.     res = xalloc(to - from + 2);
  2415.     strncpy(res, arg[0].u.string + from, to - from + 1);
  2416.     res[to - from + 1] = '\0';
  2417.     pop_n_elems(3);
  2418.     push_malloced_string(res);
  2419.     break;
  2420.     }
  2421.     CASE(F_RANGE);
  2422.     {
  2423.     if (sp[-1].type != T_NUMBER)
  2424.         error("Bad type of start interval to [ .. ] range.\n");
  2425.     if (sp[0].type != T_NUMBER)
  2426.         error("Bad type of end interval to [ .. ] range.\n");
  2427.     if (sp[-2].type == T_POINTER) {
  2428.         struct vector *v;
  2429.  
  2430.         v = slice_array(sp[-2].u.vec, sp[-1].u.number, sp[0].u.number);
  2431.         pop_n_elems(3);
  2432.         if (v) {
  2433.         push_vector(v);
  2434.         v->ref--;    /* Will make ref count == 1 */
  2435.         } else {
  2436.         push_number(0);
  2437.         }
  2438.     } else if (sp[-2].type == T_STRING) {
  2439.         int len, from, to;
  2440.         char *res;
  2441.         
  2442.         len = strlen(sp[-2].u.string);
  2443.         from = sp[-1].u.number;
  2444.         if (from < 0)
  2445.         from = len + from;
  2446.         if (from >= len) {
  2447.         pop_n_elems(3);
  2448.         push_string("", STRING_CONSTANT);
  2449.         break;
  2450.         }
  2451.         to = sp[0].u.number;
  2452.         if (to < 0)
  2453.         to = len + to;
  2454.         if (to < from) {
  2455.         pop_n_elems(3);
  2456.         push_string("", STRING_CONSTANT);
  2457.         break;
  2458.         }
  2459.         if (to >= len)
  2460.         to = len-1;
  2461.         if (to == len-1) {
  2462.         res = string_copy(sp[-2].u.string + from);
  2463.         pop_n_elems(3);
  2464.         push_malloced_string(res);
  2465.         break;
  2466.         }
  2467.         res = xalloc(to - from + 2);
  2468.         strncpy(res, sp[-2].u.string + from, to - from + 1);
  2469.         res[to - from + 1] = '\0';
  2470.         pop_n_elems(3);
  2471.         push_malloced_string(res);
  2472.     } else {
  2473.         error("Bad argument to [ .. ] range operand.\n");
  2474.     }
  2475.     break;
  2476.     }
  2477.     CASE(F_QUERY_VERB);
  2478.     if (last_verb == 0) {
  2479.         push_number(0);
  2480.         break;
  2481.     }
  2482.     push_string(last_verb, STRING_CONSTANT);
  2483.     break;
  2484.     CASE(F_EXEC);
  2485.  
  2486.     i = replace_interactive((sp-1)->u.ob, sp->u.ob, current_prog->name);
  2487.     pop_stack();
  2488.     pop_stack();
  2489.     push_number(i);
  2490.     break;
  2491.  
  2492.     CASE(F_FILE_NAME);
  2493.     {
  2494.     char *name,*res;
  2495.  
  2496.     /* This function now returns a leading '/', except when -o flag */
  2497.     name = sp->u.ob->name;
  2498. #ifdef COMPAT_MODE
  2499.     res = string_copy(name);
  2500. #else
  2501.     res = add_slash(name);
  2502. #endif    
  2503.     pop_stack();
  2504.     push_malloced_string(res);
  2505.     break;
  2506.     }
  2507.     CASE(F_USERS);
  2508.     push_vector(users());    /* users() has already set ref count to 1 */
  2509.     sp->u.vec->ref--;
  2510.     break;
  2511.     CASE(F_CALL_OUT);
  2512.     {
  2513.         struct svalue *arg = sp - num_arg + 1;
  2514.  
  2515.         if (!(current_object->flags & O_DESTRUCTED))
  2516. #if 0
  2517.         new_call_out(current_object, arg[0].u.string, arg[1].u.number,
  2518.                  num_arg == 3 ? sp : 0);
  2519. #else
  2520.         new_call_out(current_object, arg[0].u.string, arg[1].u.number,
  2521.                  num_arg > 2 ? &arg[2] : 0, num_arg - 2);
  2522. #endif
  2523.         pop_n_elems(num_arg);
  2524.         push_number(0);
  2525.         break;
  2526.     }
  2527.     CASE(F_CALL_OUT_INFO);
  2528.     push_vector(get_all_call_outs());
  2529.     sp->u.vec->ref--;    /* Was set to 1 at allocation */
  2530.     break;
  2531.     CASE(F_REMOVE_CALL_OUT);
  2532.     i = remove_call_out(current_object, sp->u.string);
  2533.     pop_stack();
  2534.     push_number(i);
  2535.     break;
  2536.     CASE(F_FIND_CALL_OUT);
  2537.         i = find_call_out(current_object, sp->u.string);
  2538.       pop_stack();
  2539.     push_number(i);
  2540.         break;
  2541. #ifdef F_INHERIT_LIST
  2542.     CASE(F_INHERIT_LIST)
  2543.     {
  2544.     struct vector *vec;
  2545.     extern struct vector *inherit_list PROT((struct object *));
  2546.  
  2547.     vec = inherit_list(sp->u.ob);
  2548.     pop_stack();
  2549.     push_vector(vec);
  2550.     break;
  2551.     }
  2552. #endif /* F_INHERIT_LIST */
  2553.     CASE(F_WRITE);
  2554.     do_write(sp);
  2555.     break;
  2556. #ifdef F_SPRINTF
  2557.     CASE(F_SPRINTF);
  2558.     {
  2559.     extern char *string_print_formatted PROT((char *,int, struct svalue *));
  2560.     char *s;
  2561.     
  2562.     /*
  2563.      * string_print_formatted() returns a pointer to it's internal
  2564.      * buffer, or to an internal constant...  Either way, it must
  2565.      * be copied before it's returned as a string.
  2566.      */
  2567.     
  2568.     s = string_print_formatted((sp-num_arg+1)->u.string,
  2569.                    num_arg-1, sp-num_arg+2);
  2570.     pop_n_elems(num_arg);
  2571.     if (!s)
  2572.         push_number(0);
  2573.     else
  2574.         push_malloced_string(string_copy(s));
  2575.     break;
  2576.     }
  2577. #endif
  2578. #ifdef F_PRINTF
  2579.     CASE(F_PRINTF);
  2580.     {
  2581.     extern char *string_print_formatted PROT((char *,int, struct svalue *));
  2582.     char *s;
  2583.     struct svalue sv;
  2584.  
  2585.     s = string_print_formatted((sp-num_arg+1)->u.string,
  2586.                    num_arg-1, sp-num_arg+2);
  2587.     sv.type = T_STRING;
  2588.     sv.u.string = string_copy(s);
  2589.     sv.string_type = STRING_MALLOC;
  2590.     do_write(&sv);
  2591.     free_svalue(&sv);
  2592.     pop_n_elems(num_arg);
  2593.     push_number(0);
  2594.     break;
  2595.     }
  2596. #endif
  2597.     CASE (F_MEMBER_ARRAY);
  2598.     {
  2599.     struct vector *v;
  2600.  
  2601.     v = sp->u.vec;
  2602.     check_for_destr(v);
  2603.     for (i=0; i < v->size; i++) {
  2604.         if (v->item[i].type != (sp-1)->type)
  2605.         continue;
  2606.         switch((sp-1)->type) {
  2607.         case T_STRING:
  2608.         if (strcmp((sp-1)->u.string, v->item[i].u.string) == 0)
  2609.             break;
  2610.         continue;
  2611.         case T_POINTER:
  2612.         if ((sp-1)->u.vec == v->item[i].u.vec)
  2613.             break;
  2614.         continue;
  2615.         case T_MAPPING:
  2616.         if ((sp-1)->u.vec == v->item[i].u.vec ||
  2617.             ((sp-1)->u.vec->item[0].u.vec->size == 0 &&
  2618.              v->item[i].u.vec->item[0].u.vec->size == 0))
  2619.             break;
  2620.         continue;
  2621.         case T_OBJECT:
  2622.         if ((sp-1)->u.ob == v->item[i].u.ob)
  2623.             break;
  2624.         continue;
  2625.         case T_NUMBER:
  2626.         if ((sp-1)->u.number == v->item[i].u.number)
  2627.             break;
  2628.         continue;
  2629.         default:
  2630.         fatal("Bad type to member_array(): %d\n", (sp-1)->type);
  2631.         }
  2632.         break;
  2633.     }
  2634.     if (i == v->size)
  2635.         i = -1;        /* Return -1 for failure */
  2636.     pop_n_elems(2);
  2637.     push_number(i);
  2638.     break;
  2639.     }
  2640.     CASE(F_MOVE_OBJECT);
  2641.     {
  2642.     struct object *o1, *o2;
  2643.  
  2644.     if ((sp-1)->type == T_OBJECT)
  2645.         o1 = (sp-1)->u.ob;
  2646.     else {
  2647.         o1 = find_object((sp-1)->u.string);
  2648.         if (o1 == 0)
  2649.         error("move_object failed\n");
  2650.     }
  2651.     if (sp->type == T_OBJECT)
  2652.         o2 = sp->u.ob;
  2653.     else {
  2654.         o2 = find_object(sp->u.string);
  2655.         if (o2 == 0)
  2656.         error("move_object failed\n");
  2657.     }
  2658.     move_object(o1, o2);
  2659.     pop_stack();
  2660.     break;
  2661.     }
  2662.     CASE(F_FUNCTION_EXISTS);
  2663.     {
  2664.     char *str, *res;
  2665.  
  2666.     str = function_exists((sp-1)->u.string, sp->u.ob);
  2667.     pop_n_elems(2);
  2668.     if (str) {
  2669. #ifdef COMPAT_MODE
  2670.         res = string_copy (str); /* Marion sighs deeply. */
  2671. #else
  2672.         res = add_slash(str);
  2673. #endif
  2674.         if (str = strrchr (res, '.'))
  2675.         *str = 0;
  2676.         push_malloced_string(res);
  2677.     } else {
  2678.         push_number(0);
  2679.     }
  2680.     break;
  2681.     }
  2682.     CASE(F_SNOOP);
  2683.     /* This one takes a variable number of arguments. It returns
  2684.      * 0 or an object.
  2685.      */
  2686. #ifdef COMPAT_MODE
  2687. #ifdef NLHACK
  2688.     if (!current_object || !current_object->interactive || num_arg == 2) {
  2689. #else
  2690.     if (!command_giver || num_arg == 2) {
  2691. #endif
  2692.         pop_n_elems (num_arg);
  2693.         push_number (0);
  2694.     } else {
  2695.         if (num_arg == 0) {
  2696. #ifdef NLHACK
  2697.         set_snoop(current_object, 0);
  2698. #else
  2699.         set_snoop(command_giver, 0);
  2700. #endif
  2701.         push_number(0);
  2702.         } else {
  2703.         /* The argument object is returned. */
  2704. #ifdef NLHACK
  2705.         set_snoop(current_object, sp->u.ob);
  2706. #else
  2707.         set_snoop(command_giver, sp->u.ob);
  2708. #endif
  2709.         }
  2710.     }
  2711. #else
  2712.     if (!command_giver) {
  2713.         pop_n_elems(num_arg);
  2714.         push_number(0);
  2715.     } else {
  2716.         ob = 0; /* Do not remove this, it is not 0 by default */
  2717.         switch (num_arg) {
  2718.         case 1:
  2719.         if (new_set_snoop(sp->u.ob, 0))
  2720.             ob = sp->u.ob;
  2721.         break;
  2722.         case 2:
  2723.         if (new_set_snoop((sp-1)->u.ob, sp->u.ob))
  2724.             ob = sp->u.ob;
  2725.         break;
  2726.         default:
  2727.         ob = 0;
  2728.         break;
  2729.         }
  2730.         pop_n_elems(num_arg);
  2731.         if (ob)
  2732.         push_object(ob);
  2733.         else
  2734.         push_number(0);
  2735.     }
  2736. #endif
  2737.     break;
  2738.     CASE(F_ADD_ACTION);
  2739.     {
  2740.     struct svalue *arg = sp - num_arg + 1;
  2741.     if (num_arg == 3) {
  2742.         if (arg[2].type != T_NUMBER)
  2743.         bad_arg(3, instruction);
  2744.     }
  2745.     add_action(arg[0].u.string,
  2746.            num_arg > 1 ? arg[1].u.string : 0,
  2747.            num_arg > 2 ? arg[2].u.number : 0);
  2748.     pop_n_elems(num_arg-1);
  2749.     break;
  2750.     }
  2751. #ifdef F_ADD_VERB
  2752.     CASE(F_ADD_VERB);
  2753.     add_verb(sp->u.string,0);
  2754.     break;
  2755. #endif /* F_ADD_VERB */
  2756. #ifdef F_ADD_XVERB
  2757.     CASE(F_ADD_XVERB);
  2758.        add_verb(sp->u.string,1);
  2759.     break;
  2760. #endif /* F_ADD_XVERB */
  2761.     CASE(F_ALLOCATE);
  2762.     {
  2763.     struct vector *v;
  2764.  
  2765.     v = allocate_array(sp->u.number);    /* Will have ref count == 1 */
  2766.     pop_stack();
  2767.     push_vector(v);
  2768.     v->ref--;
  2769.     break;
  2770.     }
  2771.     CASE(F_ED);
  2772. #ifdef NLHACK
  2773.     if (!command_giver) {
  2774.         pop_n_elems(num_arg);
  2775.         push_number(0);
  2776.         break;
  2777.     }
  2778.     if (command_giver->name != current_object->name) {
  2779.         add_message("Illegal use of ed.\n");
  2780.         pop_n_elems(num_arg);
  2781.         push_number(0);
  2782.         break;
  2783.     }
  2784.     if (num_arg && !legal_path(num_arg==1?sp->u.string:(sp-1)->u.string)) {
  2785.         add_message("Illegal path.\n");
  2786.         pop_n_elems(num_arg);
  2787.         push_number(0);
  2788.         break;
  2789.     }
  2790. #endif
  2791.     if (num_arg == 0) {
  2792.         struct svalue *arg;
  2793.         char *err_file;
  2794.  
  2795.         if (command_giver == 0 || command_giver->interactive == 0) {
  2796.         push_number(0);
  2797.         break;
  2798.         }
  2799.         arg = sapply("query_real_name", command_giver, 0);
  2800.         if (arg == 0 || arg->type != T_STRING) {
  2801.         push_number(0);
  2802.         break;
  2803.         }
  2804.         err_file = get_error_file(arg->u.string);
  2805.         if (err_file == 0) {
  2806.         push_number(0);
  2807.         break;
  2808.         }
  2809.         ed_start(err_file, 0, 0);
  2810.         push_number(1);
  2811.         break;
  2812.     } else if (num_arg == 1) {
  2813.         ed_start(sp->u.string, 0, 0);
  2814.     } else {
  2815.         if (sp->type == T_STRING)
  2816.             ed_start((sp-1)->u.string, sp->u.string, current_object);
  2817.         else
  2818.         ed_start((sp-1)->u.string, 0 , 0);
  2819.         pop_stack();
  2820.     }
  2821.     break;
  2822. #ifdef MSDOS
  2823.     CASE(F_VEDIT);
  2824.     vedit(sp->u.string);
  2825.     break;
  2826. #endif
  2827.     CASE(F_CRYPT);
  2828.     {
  2829.     char salt[2];
  2830.     char *res;
  2831.     char *choise =
  2832.         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./";
  2833.  
  2834.     if (sp->type == T_STRING && strlen(sp->u.string) >= 2) {
  2835.         salt[0] = sp->u.string[0];
  2836.         salt[1] = sp->u.string[1];
  2837.     } else {
  2838.         salt[0] = choise[random_number(strlen(choise))];
  2839.         salt[1] = choise[random_number(strlen(choise))];
  2840.     }
  2841. #ifdef sun
  2842.     res = string_copy(_crypt((sp-1)->u.string, salt));
  2843. #else
  2844.     res = string_copy(crypt((sp-1)->u.string, salt));
  2845. #endif
  2846.     pop_n_elems(2);
  2847.     push_malloced_string(res);
  2848.     break;
  2849.     }
  2850. #ifdef F_CREATE_WIZARD
  2851.     CASE(F_CREATE_WIZARD);
  2852.     {
  2853.     char *str;
  2854.     struct svalue *arg = sp - num_arg + 1;
  2855.     str = create_wizard(arg[0].u.string,
  2856.                 num_arg == 2 ? arg[1].u.string : 0);
  2857.     pop_n_elems(num_arg);
  2858.     if (str)
  2859.         push_string(str, STRING_MALLOC);
  2860.     else
  2861.         push_number(0);
  2862.     break;
  2863.     }
  2864. #endif
  2865.     CASE(F_DESTRUCT);
  2866.     destruct_object(sp);
  2867.     break;
  2868.     CASE(F_RANDOM);
  2869.     if (sp->u.number <= 0) {
  2870.         sp->u.number = 0;
  2871.         break;
  2872.     }
  2873.     sp->u.number = random_number(sp->u.number);
  2874.     break;
  2875. #ifdef F_SAY
  2876.     CASE(F_SAY);
  2877.     {
  2878.     static struct {
  2879.         struct vector v;
  2880.         struct svalue second_item[1];
  2881.     } vtmp = { { 2, 1,
  2882. #ifdef DEBUG
  2883.              1,
  2884. #endif
  2885.              (struct wiz_list *)NULL,
  2886.          { { T_NUMBER } } }, { { T_OBJECT } }
  2887.            };
  2888.     
  2889.     if (num_arg == 1) {
  2890.         vtmp.v.item[0].type = T_NUMBER; /* this marks the place for the
  2891.                            command_giver
  2892.                            */
  2893.         vtmp.v.item[1].type = T_NUMBER; /* will not match any object... */
  2894.         say(sp, &vtmp.v);
  2895.     } else {
  2896.         if ( sp->type == T_POINTER ) {
  2897.         if (sp->u.vec->ref > 1) {
  2898.             struct vector *vtmpp =
  2899.             slice_array(sp->u.vec, 0, sp->u.vec->size-1);
  2900.             say(sp-1, vtmpp);
  2901.             free_vector(vtmpp);
  2902.         } else
  2903.                 say(sp-1, sp->u.vec);
  2904.         } else {
  2905.             vtmp.v.item[0].type = T_NUMBER;
  2906.         vtmp.v.item[1].type = T_OBJECT;
  2907.             vtmp.v.item[1].u.ob = sp->u.ob;
  2908.         add_ref(sp->u.ob, "say");
  2909.             say(sp-1, &vtmp.v);
  2910.         }
  2911.         pop_stack();
  2912.     }
  2913.     break;
  2914.     }
  2915. #endif /* F_SAY */
  2916. #ifdef F_TELL_ROOM
  2917.     CASE(F_TELL_ROOM);
  2918.     {
  2919.     extern struct vector null_vector;
  2920.     struct svalue *arg = sp- num_arg + 1;
  2921.     struct vector *avoid;
  2922.  
  2923.     if (arg[0].type == T_OBJECT)
  2924.         ob = arg[0].u.ob;
  2925.     else {
  2926.         ob = find_object(arg[0].u.string);
  2927.         if (ob == 0)
  2928.         error("Object not found.\n");
  2929.     }
  2930.     if (num_arg == 2) {
  2931.         avoid = &null_vector;
  2932.         avoid->ref++;
  2933.     } else {
  2934.         extern struct vector *order_alist PROT((struct vector *));
  2935.         struct vector *vtmpp;
  2936.         static struct vector vtmp = { 1, 1,
  2937. #ifdef DEBUG
  2938.         1,
  2939. #endif
  2940.         (struct wiz_list *)NULL,
  2941.         { { T_POINTER } }
  2942.         };
  2943.  
  2944.         if (arg[2].type != T_POINTER)
  2945.         bad_arg(3, instruction);
  2946.         vtmp.item[0].u.vec = arg[2].u.vec;
  2947.         if (vtmp.item[0].u.vec->ref > 1) {
  2948.         vtmp.item[0].u.vec->ref--;
  2949.         vtmp.item[0].u.vec = slice_array(
  2950.           vtmp.item[0].u.vec, 0, vtmp.item[0].u.vec->size-1);
  2951.         }
  2952.         sp--;
  2953.         vtmpp = order_alist(&vtmp);
  2954.         avoid = vtmpp->item[0].u.vec;
  2955.         vtmpp->item[0].u.vec = vtmp.item[0].u.vec;
  2956.         free_vector(vtmpp);
  2957.     }
  2958.     tell_room(ob, sp, avoid);
  2959.     free_vector(avoid);
  2960.     pop_stack();
  2961.     break;
  2962.     }
  2963. #endif /* F_TELL_ROOM */
  2964. #ifdef F_SHOUT
  2965.     CASE(F_SHOUT);
  2966.     shout_string(sp->u.string);
  2967.     break;
  2968. #endif /* F_SHOUT */
  2969.     CASE(F_WHILE);
  2970.     fatal("F_WHILE should not appear.\n");
  2971.     CASE(F_DO);
  2972.     fatal("F_DO should not appear.\n");
  2973.     CASE(F_FOR);
  2974.     fatal("F_FOR should not appear.\n");
  2975.     CASE(F_SWITCH);
  2976.     {
  2977.     unsigned short offset,break_adr;
  2978.     int d,s,r;
  2979.     char *l,*end_tab;
  2980.     static short off_tab[] = { 0*6,1*6,3*6,7*6,15*6,31*6,63*6,127*6,255*6,
  2981.                     511*6,1023*6,2047*6,4095*6,8191*6 };
  2982.  
  2983.     ((char *)&offset)[0] = pc[1];
  2984.     ((char *)&offset)[1] = pc[2];
  2985.     ((char *)&break_adr)[0] = pc[3];
  2986.     ((char *)&break_adr)[1] = pc[4];
  2987.     *--break_sp = break_adr;
  2988.     if ( ( i = EXTRACT_UCHAR(pc) >> 4 ) != 0xf ) {
  2989.         if ( sp->type == T_NUMBER && !sp->u.number ) {
  2990.         /* special case: uninitalized string */
  2991.         s = (int) ZERO_AS_STR_CASE_LABEL;
  2992.         } else if ( sp->type == T_STRING ) {
  2993.             switch(sp->string_type) {
  2994.             case STRING_SHARED:
  2995.                 s = (int)sp->u.string;
  2996.                 break;
  2997.         default:
  2998.             s = (int)findstring(sp->u.string);
  2999.                 break;
  3000.             }
  3001.         } else {
  3002.         bad_arg(1, F_SWITCH);
  3003.         }
  3004.     } else {
  3005.         if (sp->type != T_NUMBER) bad_arg(1, F_SWITCH);
  3006.         s = sp->u.number;
  3007.         i = (int)pc[0] &0xf ;
  3008.     }
  3009.     pop_stack();
  3010.     end_tab = current_prog->program + break_adr;
  3011.     if ( i >= 14 )
  3012.         if ( i == 14 ) {
  3013.         /* fastest switch format : lookup table */
  3014.             l = current_prog->program + offset;
  3015.                 ((char *)&d)[0] = end_tab[-4];
  3016.                 ((char *)&d)[1] = end_tab[-3];
  3017.                 ((char *)&d)[2] = end_tab[-2];
  3018.                 ((char *)&d)[3] = end_tab[-1];
  3019.         if ( s >= d && l + (s=(s-d)*sizeof(short)) < end_tab - 4 ) {
  3020.             ((char *)&offset)[0] = l[s];
  3021.             ((char *)&offset)[1] = l[s+1];
  3022.             if (offset) {
  3023.             pc = current_prog->program + offset;
  3024.             break;
  3025.             }
  3026.         }
  3027.         /* default */
  3028.         ((char *)&offset)[0] = pc[5];
  3029.         ((char *)&offset)[1] = pc[6];
  3030.         pc = current_prog->program + offset;
  3031.         break;
  3032.         } else
  3033.         fatal("unsupported switch table format.\n");
  3034.     l = current_prog->program + offset + off_tab[i];
  3035.     d = (off_tab[i]+6) >> 1;
  3036.     if (d == 3) d=0;
  3037.     for(;;) {
  3038.         ((char *)&r)[0] = l[0];
  3039.         ((char *)&r)[1] = l[1];
  3040.         ((char *)&r)[2] = l[2];
  3041.         ((char *)&r)[3] = l[3];
  3042.         if (s < r)
  3043.                 if (d < 6) {
  3044.                     if (!d) { /* test for range */
  3045.             ((char *)&offset)[0] = l[-2];
  3046.             ((char *)&offset)[1] = l[-1];
  3047.  
  3048.             /* F_BREAK is required to be > 1 */
  3049.             if (offset <= 1) {
  3050.                     ((char *)&r)[0] = l[-6];
  3051.                     ((char *)&r)[1] = l[-5];
  3052.                     ((char *)&r)[2] = l[-4];
  3053.                     ((char *)&r)[3] = l[-3];
  3054.                 if (s >= r) {
  3055.                 /* s is in the range */
  3056.                 if (!offset) {
  3057.                     /* range with lookup table */
  3058.                                     ((char *)&offset)[0] = l[4];
  3059.                                     ((char *)&offset)[1] = l[5];
  3060.                     l = current_prog->program + offset +
  3061.                     (s-r) * sizeof(short);
  3062.                                     ((char *)&offset)[0] = l[0];
  3063.                                     ((char *)&offset)[1] = l[1];
  3064.                     break;
  3065.                 }
  3066.                 ((char *)&offset)[0] = l[4];
  3067.                 ((char *)&offset)[1] = l[5];
  3068.                 break;
  3069.                 }
  3070.             }
  3071.             /* use default address */
  3072.                         ((char *)&offset)[0] = pc[5];
  3073.                         ((char *)&offset)[1] = pc[6];
  3074.                         break;
  3075.                     } /* !d */
  3076.                     d = 0;
  3077.                 } else {
  3078.             /* d >= 6 */
  3079.                     l -= d;
  3080.                     d >>= 1;
  3081.         }
  3082.         else if (s > r) {
  3083.                 if (d < 6) {
  3084.                     if (!d) { /* test for range */
  3085.             ((char *)&offset)[0] = l[4];
  3086.             ((char *)&offset)[1] = l[5];
  3087.             if (offset <= 1) {
  3088.                     ((char *)&r)[0] = l[6];
  3089.                     ((char *)&r)[1] = l[7];
  3090.                     ((char *)&r)[2] = l[8];
  3091.                     ((char *)&r)[3] = l[9];
  3092.                 if (s <= r) {
  3093.                 /* s is in the range */
  3094.                 if (!offset) {
  3095.                     /* range with lookup table */
  3096.                                     ((char *)&offset)[0] = l[10];
  3097.                                     ((char *)&offset)[1] = l[11];
  3098.                     l = current_prog->program + offset +
  3099.                     (s-r) * sizeof(short);
  3100.                                     ((char *)&offset)[0] = l[0];
  3101.                                     ((char *)&offset)[1] = l[1];
  3102.                     break;
  3103.                 }
  3104.                 ((char *)&offset)[0] = l[10];
  3105.                 ((char *)&offset)[1] = l[11];
  3106.                 break;
  3107.                 }
  3108.             }
  3109.             /* use default address */
  3110.                         ((char *)&offset)[0] = pc[5];
  3111.                         ((char *)&offset)[1] = pc[6];
  3112.                         break;
  3113.                     } /* !d */
  3114.                     d = 0;
  3115.                 } else {
  3116.             /* d >= 6 */
  3117.                     l += d;
  3118.                     while (l >= end_tab) {
  3119.                         d >>= 1;
  3120.                         if (d <= 3) {
  3121.                             if (!d) break;
  3122.                             d = 0;
  3123.                         }
  3124.                         l -= d;
  3125.                     }
  3126.             d >>= 1;
  3127.         }
  3128.         } else {
  3129.         /* s == r */
  3130.         ((char *)&offset)[0] = l[4];
  3131.         ((char *)&offset)[1] = l[5];
  3132.         if ( !l[-2] && !l[-1] ) {
  3133.             /* end of range with lookup table */
  3134.             ((char *)&r)[0] = l[-6];
  3135.             ((char *)&r)[1] = l[-5];
  3136.             ((char *)&r)[2] = l[-4];
  3137.             ((char *)&r)[3] = l[-3];
  3138.             l = current_prog->program + offset + (s-r)*sizeof(short);
  3139.                     ((char *)&offset)[0] = l[0];
  3140.                     ((char *)&offset)[1] = l[1];
  3141.         }
  3142.         if (offset <= 1) {
  3143.             if (!offset) {
  3144.             /* start of range with lookup table */
  3145.                         ((char *)&offset)[0] = l[10];
  3146.                         ((char *)&offset)[1] = l[11];
  3147.             l = current_prog->program + offset;
  3148.                         ((char *)&offset)[0] = l[0];
  3149.                         ((char *)&offset)[1] = l[1];
  3150.             } else {
  3151.                         ((char *)&offset)[0] = l[10];
  3152.                         ((char *)&offset)[1] = l[11];
  3153.             }
  3154.         }
  3155.         break;
  3156.         }
  3157.     }
  3158.     pc = current_prog->program + offset;
  3159.     break;
  3160.     }
  3161.     CASE(F_BREAK);
  3162.     {
  3163.     pc = current_prog->program + *break_sp++;
  3164.     break;
  3165.     }
  3166.     CASE(F_SUBSCRIPT);
  3167.     fatal("F_SUBSCRIPT should not appear.\n");
  3168.     CASE(F_STRLEN);
  3169.     i = strlen(sp->u.string);
  3170.     pop_stack();
  3171.     push_number(i);
  3172.     break;
  3173.     CASE(F_MKMAPPING);
  3174.     {
  3175.         struct vector *v;
  3176.  
  3177.         i = (sp-1)->u.vec->size;
  3178.         if (i > sp->u.vec->size) {
  3179.         i = sp->u.vec->size;
  3180.         }
  3181.         v = allocate_mapping(slice_array((sp-1)->u.vec, 0, i - 1),
  3182.                  slice_array(sp->u.vec, 0, i - 1));
  3183.         pop_n_elems(2);
  3184.         push_mapping(order_alist(v));
  3185.         free_mapping(v);
  3186.         sp->u.vec->ref--; /* This will make ref count == 1 */
  3187.         break;
  3188.     }
  3189.     CASE(F_M_SIZEOF);
  3190.     i = sp->u.vec->item[0].u.vec->size;
  3191.     pop_stack();
  3192.     push_number(i);
  3193.     break;
  3194.     CASE(F_M_INDICES);
  3195.     {
  3196.         struct vector *v;
  3197.  
  3198.         v = sp->u.vec;
  3199.         check_map_for_destr(v);
  3200.         v = v->item[0].u.vec;
  3201.         v = slice_array(v, 0, v->size - 1);
  3202.         pop_stack();
  3203.         push_vector(v);
  3204.         v->ref--;    /* Will make ref count == 1 */
  3205.         break;
  3206.     }
  3207.     CASE(F_M_VALUES);
  3208.     {
  3209.         struct vector *v;
  3210.  
  3211.         v = sp->u.vec;
  3212.         check_map_for_destr(v);
  3213.         v = v->item[1].u.vec;
  3214.         v = slice_array(v, 0, v->size - 1);
  3215.         pop_stack();
  3216.         push_vector(v);
  3217.         v->ref--;    /* Will make ref count == 1 */
  3218.         break;
  3219.     }
  3220.     CASE(F_M_DELETE);
  3221.     check_map_for_destr((sp-1)->u.vec);
  3222.     i = assoc(sp, (sp-1)->u.vec->item[0].u.vec);
  3223.     pop_stack();
  3224.     if (i >= 0) {
  3225.         struct vector *v, *w;
  3226.  
  3227.         v = sp->u.vec->item[0].u.vec;
  3228.         w = sp->u.vec->item[1].u.vec;
  3229.         v = allocate_mapping(slice_array(v, 0, v->size-1),
  3230.                  slice_array(w, 0, w->size-1));
  3231.         pop_stack();
  3232.         remove_mapping(v, i);
  3233.         push_mapping(v);
  3234.         v->ref--;    /* Will make ref count == 1 */
  3235.     }
  3236.     break;
  3237.     CASE(F_SIZEOF);
  3238.     i = sp->u.vec->size;
  3239.     pop_stack();
  3240.     push_number(i);
  3241.     break;
  3242.     CASE(F_LOWER_CASE);
  3243.     {
  3244.     char *str = string_copy(sp->u.string);
  3245.     for (i = strlen(str)-1; i>=0; i--)
  3246.         if (isalpha(str[i]))
  3247.         str[i] |= 'a' - 'A';
  3248.     pop_stack();
  3249.     push_malloced_string(str);
  3250.     break;
  3251.     }
  3252.     CASE(F_QUERY_HEART_BEAT);
  3253.     {
  3254.     struct object *ob;
  3255.  
  3256.     ob = sp->u.ob;
  3257.     pop_stack();
  3258.     if (ob->flags & O_DESTRUCTED)
  3259.         push_number(0);
  3260.     else
  3261.         push_number((ob->flags & O_HEART_BEAT) ? 1 : 0);
  3262.     break;
  3263.     }
  3264.     CASE(F_SET_HEART_BEAT);
  3265.     i = set_heart_beat(current_object, sp->u.number);
  3266.     sp->u.number = i;
  3267.     break;
  3268.     CASE(F_CAPITALIZE);
  3269.     if (islower(sp->u.string[0])) {
  3270.         char *str;
  3271.  
  3272.         str = string_copy(sp->u.string);
  3273.         str[0] += 'A' - 'a';
  3274.         pop_stack();
  3275.         push_malloced_string(str);
  3276.     }
  3277.     break;
  3278.     CASE(F_PROCESS_STRING);
  3279.     {
  3280.     extern char
  3281.         *process_string PROT((char *));
  3282.  
  3283.     char *str;
  3284.  
  3285.     str = process_string(sp->u.string);
  3286.     if (str != sp->u.string) {
  3287.         pop_stack();
  3288.         push_malloced_string(str);
  3289.     }
  3290.     break;
  3291.     }
  3292.     CASE(F_COMMAND);
  3293.     {
  3294.     struct svalue *arg = sp - num_arg + 1;
  3295.  
  3296.     if (num_arg == 1)
  3297.         i = command_for_object(arg[0].u.string, 0);
  3298.     else
  3299. #ifdef COMPAT_MODE
  3300.         i = command_for_object(arg[0].u.string, arg[1].u.ob);
  3301. #else
  3302.         error("Too many arguments to command()\n");
  3303. #endif
  3304.     pop_n_elems(num_arg);
  3305.     push_number(i);
  3306.     break;
  3307.     }
  3308.     CASE(F_GET_DIR);
  3309.     {
  3310.     struct vector *v = get_dir(sp->u.string);
  3311.     pop_stack();
  3312.     if (v) {
  3313.         push_vector(v);
  3314.         v->ref--;    /* Will now be 1. */
  3315.     } else
  3316.         push_number(0);
  3317.     break;
  3318.     }
  3319.     CASE(F_RM);
  3320.     i = remove_file(sp->u.string);
  3321.     pop_stack();
  3322.     push_number(i);
  3323.     break;
  3324.     CASE(F_CAT);
  3325.     {
  3326.     struct svalue *arg = sp- num_arg + 1;
  3327.     int start = 0, len = 0;
  3328.  
  3329.     if (num_arg > 1)
  3330.         start = arg[1].u.number;
  3331.     if (num_arg == 3) {
  3332.         if (arg[2].type != T_NUMBER)
  3333.         bad_arg(2, instruction);
  3334.         len = arg[2].u.number;
  3335.     }
  3336.     i = print_file(arg[0].u.string, start, len);
  3337.     pop_n_elems(num_arg);
  3338.     push_number(i);
  3339.     break;
  3340.     }
  3341.     CASE(F_MKDIR);
  3342.     {
  3343.     char *path;
  3344.  
  3345. #ifdef COMPAT_MODE
  3346.     path = check_file_name(sp->u.string, 1);
  3347. #else
  3348.     path = check_valid_path(sp->u.string, current_object->eff_user, "mkdir", 1);
  3349. #endif    
  3350.     /* pop_stack(); see comment above... */
  3351.     if (path == 0 || mkdir(path, 0770) == -1)
  3352.         assign_svalue(sp, &const0);
  3353.     else
  3354.         assign_svalue(sp, &const1);
  3355.     break;
  3356.     }
  3357.     CASE(F_RMDIR);
  3358.     {
  3359.     char *path;
  3360.  
  3361. #ifdef COMPAT_MODE    
  3362.     path = check_file_name(sp->u.string, 1);
  3363. #else    
  3364.     path = check_valid_path(sp->u.string, current_object->eff_user, "rmdir", 1);
  3365. #endif    
  3366.     /* pop_stack(); rw - what the heck ??? */
  3367.     if (path == 0 || rmdir(path) == -1)
  3368.         assign_svalue(sp, &const0);
  3369.     else
  3370.         assign_svalue(sp, &const1);
  3371.     break;
  3372.     }
  3373.     CASE(F_INPUT_TO);
  3374.     {
  3375.     struct svalue *arg = sp - num_arg + 1;
  3376.     int flag = 1;
  3377.     
  3378.     if (num_arg == 1 || sp->type == T_NUMBER && sp->u.number == 0)
  3379.         flag = 0;
  3380.     i = input_to(arg[0].u.string, flag);
  3381.     pop_n_elems(num_arg);
  3382.     push_number(i);
  3383.     break;
  3384.     }
  3385.     CASE(F_SET_LIVING_NAME);
  3386.     set_living_name(current_object, sp->u.string);
  3387.     break;
  3388.     CASE(F_PARSE_COMMAND);
  3389.     {
  3390.     struct svalue *arg;
  3391.  
  3392.     num_arg = EXTRACT_UCHAR(pc);
  3393.     pc++;
  3394.     arg = sp - num_arg + 1;
  3395.     if (arg[0].type != T_STRING)
  3396.         bad_arg(1, F_PARSE_COMMAND);
  3397.     if (arg[1].type != T_OBJECT && arg[1].type != T_POINTER)
  3398.         bad_arg(2, F_PARSE_COMMAND);
  3399.     if (arg[2].type != T_STRING)
  3400.         bad_arg(3, F_PARSE_COMMAND);
  3401.     if (arg[1].type == T_POINTER)
  3402.         check_for_destr(arg[1].u.vec);
  3403.  
  3404.     i = parse(arg[0].u.string, &arg[1], arg[2].u.string, &arg[3],
  3405.           num_arg-3); 
  3406.     pop_n_elems(num_arg);    /* Get rid of all arguments */
  3407.     push_number(i);        /* Push the result value */
  3408.     break;
  3409.     }
  3410.     CASE(F_SSCANF);
  3411.     num_arg = EXTRACT_UCHAR(pc);
  3412.     pc++;
  3413.     i = inter_sscanf(num_arg);
  3414.     pop_n_elems(num_arg);
  3415.     push_number(i);
  3416.     break;
  3417.     CASE(F_ENABLE_COMMANDS);
  3418.     enable_commands(1);
  3419.     push_number(1);
  3420.     break;
  3421.     CASE(F_DISABLE_COMMANDS);
  3422.     enable_commands(0);
  3423.     push_number(0);
  3424.     break;
  3425.     CASE(F_PRESENT);
  3426.     {
  3427.         struct svalue *arg = sp - num_arg + 1;
  3428.         ob = object_present(arg, num_arg == 1 ? 0 : arg[1].u.ob);
  3429.         pop_n_elems(num_arg);
  3430.         if (ob)
  3431.         push_object(ob);
  3432.         else
  3433.         push_number(0);
  3434.     }
  3435.     break;
  3436. #ifdef F_SET_LIGHT
  3437.     CASE(F_SET_LIGHT);
  3438.     {
  3439.     struct object *o1;
  3440.  
  3441.     add_light(current_object, sp->u.number);
  3442.     o1 = current_object;
  3443.     while(o1->super)
  3444.         o1 = o1->super;
  3445.     sp->u.number = o1->total_light;
  3446.     break;
  3447.     }
  3448. #endif /* F_SET_LIGHT */
  3449.     CASE(F_CONST0);
  3450.     push_number(0);
  3451.     break;
  3452.     CASE(F_CONST1);
  3453.     push_number(1);
  3454.     break;
  3455.     CASE(F_NUMBER);
  3456.     ((char *)&i)[0] = pc[0];
  3457.     ((char *)&i)[1] = pc[1];
  3458.     ((char *)&i)[2] = pc[2];
  3459.     ((char *)&i)[3] = pc[3];
  3460.     pc += 4;
  3461.     push_number(i);
  3462.     break;
  3463.     CASE(F_ASSIGN);
  3464. #ifdef DEBUG
  3465.     if (sp[-1].type != T_LVALUE)
  3466.         fatal("Bad argument to F_ASSIGN\n");
  3467. #endif
  3468.     assign_svalue((sp-1)->u.lvalue, sp);
  3469.     assign_svalue(sp-1, sp);
  3470.     pop_stack();
  3471.     break;
  3472.     CASE(F_CTIME);
  3473.     {
  3474.     char *cp;
  3475.     cp = string_copy(time_string(sp->u.number));
  3476.     pop_stack();
  3477.     push_malloced_string(cp);
  3478.     /* Now strip the newline. */
  3479.     cp = strchr(cp, '\n');
  3480.     if (cp)
  3481.         *cp = '\0';
  3482.     break;
  3483.     }
  3484.     CASE(F_ADD_EQ);
  3485.     if (sp[-1].type != T_LVALUE)
  3486.         bad_arg(1, F_ADD_EQ);
  3487.     argp = sp[-1].u.lvalue;
  3488.     switch(argp->type) {
  3489.     case T_STRING:
  3490.     {
  3491.         char *new_str;
  3492.         if (sp->type == T_STRING) {
  3493.         int l = strlen(argp->u.string);
  3494.         int l2 = strlen(sp->u.string);
  3495.         check_string_lengths(l, l2);
  3496.         new_str = xalloc(l + l2 + 1);
  3497.         strcpy(new_str, argp->u.string);
  3498.         strcpy(new_str+l, sp->u.string);
  3499.         pop_n_elems(2);
  3500.         push_malloced_string(new_str);
  3501.         } else if (sp->type == T_NUMBER) {
  3502.         char buff[20];
  3503.         sprintf(buff, "%d", sp->u.number);
  3504.         new_str = xalloc(strlen(argp->u.string) + strlen(buff) + 1);
  3505.         strcpy(new_str, argp->u.string);
  3506.         strcat(new_str, buff);
  3507.         pop_n_elems(2);
  3508.         push_malloced_string(new_str);
  3509.         } else {
  3510.         bad_arg(2, F_ADD_EQ);
  3511.         }
  3512.         break;
  3513.     }
  3514.     case T_NUMBER:
  3515.         if (sp->type == T_NUMBER) {
  3516.             i = argp->u.number + sp->u.number;
  3517.         pop_n_elems(2);
  3518.         push_number(i);
  3519.         } else {
  3520.             error("Bad type number to rhs +=.\n");
  3521.         }
  3522.         break;
  3523.     case T_MAPPING:
  3524.         if (sp->type != T_MAPPING) {
  3525.         error("Bad type to rhs +=.\n");
  3526.         } else {
  3527.         struct vector *v;
  3528.         check_map_for_destr(argp->u.vec);
  3529.         check_map_for_destr(sp->u.vec);
  3530.         v = add_mapping(argp->u.vec, sp->u.vec);
  3531.         pop_n_elems(2);
  3532.             push_mapping(v); /* This will make ref count == 2 */
  3533.             v->ref--;
  3534.         }
  3535.         break;
  3536.         case T_POINTER:
  3537.         if (sp->type != T_POINTER) {
  3538.         error("Bad type to rhs +=.\n");
  3539.         } else {
  3540.           struct vector *v;
  3541.           check_for_destr(argp->u.vec);
  3542.           check_for_destr(sp->u.vec);
  3543.           v = add_array(argp->u.vec,sp->u.vec);
  3544.           pop_n_elems(2);
  3545.           push_vector(v); /* This will make ref count == 2 */
  3546.           v->ref--;
  3547.         }
  3548.         break;          
  3549.     default:
  3550.         error("Bad type to lhs +=");
  3551.     }
  3552.     assign_svalue(argp, sp);
  3553.     break;
  3554.     CASE(F_SUB_EQ);
  3555.     if (sp[-1].type != T_LVALUE)
  3556.         bad_arg(1, F_SUB_EQ);
  3557.     argp = sp[-1].u.lvalue;
  3558.     switch (argp->type) {
  3559.     case T_NUMBER:
  3560.     if (sp->type != T_NUMBER)
  3561.             error("Bad right type to -=");
  3562.         argp->u.number -= sp->u.number;
  3563.         sp--;
  3564.             break;
  3565.     case T_POINTER:
  3566.       {
  3567.         struct vector *subtract_array PROT((struct vector*,struct vector*));
  3568.         struct vector *v;
  3569.  
  3570.         if (sp->type != T_POINTER)
  3571.             error("Bad right type to -=");
  3572.         v = sp->u.vec;
  3573.         if (v->ref > 1) {
  3574.         v = slice_array(v, 0, v->size-1 );
  3575.         v->ref--;
  3576.             }
  3577.         sp--;
  3578.         v = subtract_array(argp->u.vec, v);
  3579.         free_vector(argp->u.vec);
  3580.         argp->u.vec = v;
  3581.         break;
  3582.       }
  3583.     default:
  3584.         error("Bad left type to -=.\n");
  3585.     }
  3586.     assign_svalue_no_free(sp, argp);
  3587.     break;
  3588.     CASE(F_MULT_EQ);
  3589.     if (sp[-1].type != T_LVALUE)
  3590.         bad_arg(1, F_MULT_EQ);
  3591.     argp = sp[-1].u.lvalue;
  3592.     if (argp->type != T_NUMBER)
  3593.         error("Bad left type to *=.\n");
  3594.     if (sp->type != T_NUMBER)
  3595.         error("Bad right type to *=");
  3596.     i = argp->u.number * sp->u.number;
  3597.     pop_n_elems(2);
  3598.     push_number(i);
  3599.     assign_svalue(argp, sp);
  3600.     break;
  3601.     CASE(F_AND_EQ);
  3602.     if (sp[-1].type != T_LVALUE)
  3603.         bad_arg(1, F_AND_EQ);
  3604.     argp = sp[-1].u.lvalue;
  3605.     if (argp->type != T_NUMBER)
  3606.         error("Bad left type to &=.\n");
  3607.     if (sp->type != T_NUMBER)
  3608.         error("Bad right type to &=");
  3609.     i = argp->u.number & sp->u.number;
  3610.     pop_n_elems(2);
  3611.     push_number(i);
  3612.     assign_svalue(argp, sp);
  3613.     break;
  3614.     CASE(F_OR_EQ);
  3615.     if (sp[-1].type != T_LVALUE)
  3616.         bad_arg(1, F_OR_EQ);
  3617.     argp = sp[-1].u.lvalue;
  3618.     if (sp[-1].type != T_LVALUE)
  3619.         bad_arg(1, F_OR_EQ);
  3620.     argp = sp[-1].u.lvalue;
  3621.     if (argp->type != T_NUMBER)
  3622.         error("Bad left type to |=.\n");
  3623.     if (sp->type != T_NUMBER)
  3624.         error("Bad right type to |=");
  3625.     i = argp->u.number | sp->u.number;
  3626.     pop_n_elems(2);
  3627.     push_number(i);
  3628.     assign_svalue(argp, sp);
  3629.     break;
  3630.     CASE(F_XOR_EQ);
  3631.     if (sp[-1].type != T_LVALUE)
  3632.         bad_arg(1, F_XOR_EQ);
  3633.     argp = sp[-1].u.lvalue;
  3634.     if (argp->type != T_NUMBER)
  3635.         error("Bad left type to ^=.\n");
  3636.     if (sp->type != T_NUMBER)
  3637.         error("Bad right type to ^=");
  3638.     i = argp->u.number ^ sp->u.number;
  3639.     pop_n_elems(2);
  3640.     push_number(i);
  3641.     assign_svalue(argp, sp);
  3642.     break;
  3643.     CASE(F_LSH_EQ);
  3644.     if (sp[-1].type != T_LVALUE)
  3645.         bad_arg(1, F_LSH_EQ);
  3646.     argp = sp[-1].u.lvalue;
  3647.     if (argp->type != T_NUMBER)
  3648.         error("Bad left type to <<=.\n");
  3649.     if (sp->type != T_NUMBER)
  3650.         error("Bad right type to <<=");
  3651.     i = argp->u.number << sp->u.number;
  3652.     pop_n_elems(2);
  3653.     push_number(i);
  3654.     assign_svalue(argp, sp);
  3655.     break;
  3656.     CASE(F_RSH_EQ);
  3657.     if (sp[-1].type != T_LVALUE)
  3658.         bad_arg(1, F_RSH_EQ);
  3659.     argp = sp[-1].u.lvalue;
  3660.     if (argp->type != T_NUMBER)
  3661.         error("Bad left type to >>=.\n");
  3662.     if (sp->type != T_NUMBER)
  3663.         error("Bad right type to >>=");
  3664.     i = argp->u.number >> sp->u.number;
  3665.     pop_n_elems(2);
  3666.     push_number(i);
  3667.     assign_svalue(argp, sp);
  3668.     break;
  3669. #ifdef F_COMBINE_FREE_LIST
  3670.     CASE(F_COMBINE_FREE_LIST);
  3671. #ifdef MALLOC_malloc
  3672.     push_number(resort_free_list());
  3673. #else
  3674.     push_number(0);
  3675. #endif
  3676.     break;
  3677. #endif
  3678.     CASE(F_DIV_EQ);
  3679.     if (sp[-1].type != T_LVALUE)
  3680.         bad_arg(1, F_DIV_EQ);
  3681.     argp = sp[-1].u.lvalue;
  3682.     if (argp->type != T_NUMBER)
  3683.         error("Bad left type to /=.\n");
  3684.     if (sp->type != T_NUMBER)
  3685.         error("Bad right type to /=");
  3686.     if (sp->u.number == 0)
  3687.         error("Division by 0\n");
  3688.     i = argp->u.number / sp->u.number;
  3689.     pop_n_elems(2);
  3690.     push_number(i);
  3691.     assign_svalue(argp, sp);
  3692.     break;
  3693.     CASE(F_MOD_EQ);
  3694.     if (sp[-1].type != T_LVALUE)
  3695.         bad_arg(1, F_MOD_EQ);
  3696.     argp = sp[-1].u.lvalue;
  3697.     if (argp->type != T_NUMBER)
  3698.         error("Bad left type to %=.\n");
  3699.     if (sp->type != T_NUMBER)
  3700.         error("Bad right type to %=");
  3701.     if (sp->u.number == 0)
  3702.         error("Division by 0\n");
  3703.     i = argp->u.number % sp->u.number;
  3704.     pop_n_elems(2);
  3705.     push_number(i);
  3706.     assign_svalue(argp, sp);
  3707.     break;
  3708.     CASE(F_STRING);
  3709.     {
  3710.     unsigned short string_number;
  3711.     ((char *)&string_number)[0] = pc[0];
  3712.     ((char *)&string_number)[1] = pc[1];
  3713.     pc += 2;
  3714.     push_string(current_prog->strings[string_number],
  3715.             STRING_CONSTANT);
  3716.     break;
  3717.     }
  3718.     CASE(F_CINDENT);
  3719.     {
  3720.     char *path;
  3721.  
  3722. #ifdef COMPAT_MODE
  3723.     path = check_file_name(sp->u.string, 1);
  3724. #else
  3725.     path = check_valid_path(sp->u.string, current_object->eff_user, "cindent", 1);
  3726. #endif
  3727.     if (path) {
  3728.         if (indent_program(path)) {
  3729.         assign_svalue(sp, &const1);
  3730.         break;
  3731.         }
  3732.     } else {
  3733.         add_message("Illegal attempt to indent\n");
  3734.     }
  3735.     assign_svalue(sp, &const0);
  3736.     break;
  3737.     }
  3738.     CASE(F_DESCRIBE);
  3739.     {
  3740.     char *str;
  3741.     int live;
  3742.  
  3743.     if (num_arg < 3) live = 0;
  3744.     else {
  3745.         if (sp->type != T_NUMBER) bad_arg (3, F_DESCRIBE);
  3746.         live = sp->u.number;
  3747.         pop_stack ();
  3748.     }
  3749.     str = describe_items(sp-1, sp->u.string, live);
  3750.     pop_n_elems(2);
  3751.     if (str) push_malloced_string (string_copy (str));
  3752.     else     push_number(0);
  3753.     break;
  3754.     }
  3755.     CASE(F_UNIQUE_ARRAY); {
  3756.     extern struct vector
  3757.         *make_unique PROT((struct vector *arr,char *func,
  3758.         struct svalue *skipnum));
  3759.     struct vector *res;
  3760.  
  3761.     if (num_arg < 3) {
  3762.         check_for_destr((sp-1)->u.vec);
  3763.         res = make_unique((sp-1)->u.vec, sp->u.string, &const0);
  3764.     } else {
  3765.         check_for_destr((sp-2)->u.vec);
  3766.         res = make_unique((sp-2)->u.vec, (sp-1)->u.string, sp);
  3767.         pop_stack ();
  3768.     }
  3769.     pop_n_elems(2);
  3770.     if (res) {
  3771.         push_vector (res);    /* This will make ref count == 2 */
  3772.         res->ref--;
  3773.     } else
  3774.         push_number (0);
  3775.     break;
  3776.     }
  3777.     CASE(F_VERSION); {
  3778.     char buff[9];
  3779.     sprintf(buff, "%6.6s%02d", GAME_VERSION, PATCH_LEVEL);
  3780.         push_string(buff, STRING_MALLOC);
  3781.         break;
  3782.     }
  3783. #ifdef F_RENAME
  3784.     CASE(F_RENAME); {
  3785.     i = do_rename((sp-1)->u.string, sp->u.string);
  3786.     pop_n_elems(2);
  3787.     push_number(i);
  3788.     break;
  3789.     }
  3790. #endif /* F_RENAME */
  3791.     CASE(F_MAP_ARRAY); {
  3792.     struct vector *res;
  3793.     struct svalue *arg;
  3794.  
  3795.     arg = sp - num_arg + 1; ob = 0;
  3796.  
  3797.     if (arg[2].type == T_OBJECT)
  3798.         ob = arg[2].u.ob;
  3799.     else if (arg[2].type == T_STRING) 
  3800.         ob = find_object(arg[2].u.string);
  3801.  
  3802.     if (!ob)
  3803.         bad_arg (3, F_MAP_ARRAY);
  3804.  
  3805.     if (arg[0].type == T_POINTER) {
  3806.         check_for_destr(arg[0].u.vec);
  3807.         res = map_array (arg[0].u.vec, arg[1].u.string, ob,
  3808.                  num_arg > 3 ? sp : (struct svalue *)0);
  3809.     } else {
  3810.         res = 0;
  3811.     }
  3812.     pop_n_elems (num_arg);
  3813.     if (res) {
  3814.         push_vector (res);    /* This will make ref count == 2 */
  3815.         res->ref--;
  3816.     } else
  3817.         push_number (0);
  3818.     break;
  3819.     }
  3820.     CASE(F_MAP_MAPPING); {
  3821.     struct vector *res;
  3822.     struct svalue *arg;
  3823.  
  3824.     arg = sp - num_arg + 1; ob = 0;
  3825.  
  3826.     if (arg[2].type == T_OBJECT)
  3827.         ob = arg[2].u.ob;
  3828.     else if (arg[2].type == T_STRING) 
  3829.         ob = find_object(arg[2].u.string);
  3830.  
  3831.     if (!ob)
  3832.         bad_arg (3, F_MAP_MAPPING);
  3833.  
  3834.     if (arg[0].type == T_MAPPING) {
  3835.         check_map_for_destr(arg[0].u.vec);
  3836.         res = map_mapping (arg[0].u.vec, arg[1].u.string, ob,
  3837.                  num_arg > 3 ? sp : (struct svalue *)0);
  3838.     } else {
  3839.         res = 0;
  3840.     }
  3841.     pop_n_elems (num_arg);
  3842.     if (res) {
  3843.         push_mapping (res);    /* This will make ref count == 2 */
  3844.         res->ref--;
  3845.     } else
  3846.         push_number (0);
  3847.     break;
  3848.     }
  3849.     CASE(F_SORT_ARRAY); {
  3850.     extern struct vector *sort_array
  3851.       PROT((struct vector*,char *,struct object *));
  3852.     struct vector *res;
  3853.     struct svalue *arg;
  3854.  
  3855.     arg = sp - 2; ob = 0;
  3856.  
  3857.     if (arg[2].type == T_OBJECT)
  3858.         ob = arg[2].u.ob;
  3859.     else if (arg[2].type == T_STRING) 
  3860.         ob = find_object(arg[2].u.string);
  3861.  
  3862.     if (!ob)
  3863.         bad_arg (3, F_SORT_ARRAY);
  3864.  
  3865.     if (arg[0].type == T_POINTER) {
  3866.         /* sort_array already takes care of destructed objects */
  3867.         res = sort_array (
  3868.           slice_array(arg[0].u.vec, 0, arg[0].u.vec->size-1),
  3869.           arg[1].u.string, ob);
  3870.     } else
  3871.         res = 0;
  3872.     pop_n_elems (3);
  3873.     sp++;
  3874.     if (res) {
  3875.         sp->type = T_POINTER;
  3876.         sp->u.vec = res;
  3877.     }
  3878.     else     *sp = const0;
  3879.     break;
  3880.     }
  3881. #ifdef F_ORDER_ALIST
  3882.     CASE(F_ORDER_ALIST);
  3883.     {
  3884.     extern struct vector *order_alist PROT((struct vector *));
  3885.     struct svalue *args;
  3886.     struct vector *list;
  3887.     int listsize,keynum;
  3888.  
  3889.     if (num_arg == 1 && sp->u.vec->size 
  3890.           && sp->u.vec->item[0].type == T_POINTER) {
  3891.             args     = sp->u.vec->item;
  3892.         listsize = sp->u.vec->size;
  3893.     } else {
  3894.         args = sp-num_arg+1;
  3895.         listsize = num_arg;
  3896.     }
  3897.     keynum = args[0].u.vec->size;
  3898.     list = allocate_array(listsize);
  3899.     for (i=0; i<listsize; i++) {
  3900.         if (args[i].type != T_POINTER
  3901.          || args[i].u.vec->size != keynum) {
  3902.         free_vector(list);
  3903.         error("bad data array %d in call to order_alist",i);
  3904.         }
  3905.         list->item[i].type = T_POINTER;
  3906.         list->item[i].u.vec = slice_array(args[i].u.vec,0,keynum-1);
  3907.         }
  3908.         pop_n_elems(num_arg);
  3909.     sp++;
  3910.     sp->type = T_POINTER;
  3911.         sp->u.vec = order_alist(list);
  3912.     free_vector(list);
  3913.         break;
  3914.     }
  3915. #endif /* F_ORDER_ALIST */
  3916. #ifdef F_INSERT_ALIST
  3917.     CASE(F_INSERT_ALIST)
  3918.     {
  3919.     /* When the key list of an alist contains destructed objects
  3920.        it is better not to free them till the next reordering by
  3921.        order_alist to retain the alist property.
  3922.      */
  3923.     extern struct svalue *insert_alist
  3924.       PROT((struct svalue *key,struct svalue *key_data,
  3925.         struct vector *list));
  3926.     struct vector *list;
  3927.     int listsize,keynum;
  3928.     struct svalue *key,*key_data,*ret;
  3929.     static struct vector tempvec = { 1,1, };
  3930.  
  3931.     if (sp->type != T_POINTER)
  3932.         bad_arg(num_arg,F_INSERT_ALIST);
  3933.     if ( !(listsize = sp->u.vec->size) ||
  3934.       sp->u.vec->item[0].type != T_POINTER ) {
  3935.         list = &tempvec;
  3936.         assign_svalue_no_free(list->item,sp);
  3937.         listsize = 1;
  3938.     } else
  3939.         list = sp->u.vec;
  3940.     keynum = list->item[0].u.vec->size;
  3941.     for (i=1; i<listsize; i++) {
  3942.         if (list->item[i].type != T_POINTER
  3943.           ||list->item[i].u.vec->size != keynum)
  3944.         bad_arg(num_arg,F_INSERT_ALIST);
  3945.     }
  3946.     if (num_arg == 2) {
  3947.         if (sp[-1].type != T_POINTER) {
  3948.         key_data = (struct svalue*)NULL;
  3949.         key = sp-1;
  3950.         } else {
  3951.             if (sp[-1].u.vec->size != listsize)
  3952.             bad_arg(1,F_INSERT_ALIST);
  3953.             key_data = key = sp[-1].u.vec->item;
  3954.         }
  3955.     } else {
  3956.         if (num_arg - 1 != listsize)
  3957.         bad_arg(1,F_INSERT_ALIST);
  3958.             key_data = key = sp-num_arg+1;
  3959.     }
  3960.     ret = insert_alist(key,key_data,list);
  3961.     pop_n_elems(num_arg);
  3962.     sp++;
  3963.     *sp = *ret;
  3964.     break;
  3965.     }
  3966. #endif /* F_INSERT_ALIST */
  3967. #ifdef F_ASSOC
  3968.     CASE(F_ASSOC);
  3969.     {
  3970.     /* When the key list of an alist contains destructed objects
  3971.        it is better not to free them till the next reordering by
  3972.        order_alist to retain the alist property.
  3973.      */
  3974.     struct svalue *args = sp -num_arg +1;
  3975.     struct vector *keys,*data;
  3976.     struct svalue *fail_val;
  3977.     int ix;
  3978.  
  3979.     if ( !args[1].u.vec->size ||
  3980.       args[1].u.vec->item[0].type != T_POINTER ) {
  3981.         keys = args[1].u.vec;
  3982.         if (num_arg == 2) {
  3983.         data = (struct vector *)NULL;
  3984.         } else {
  3985.         if (args[2].type != T_POINTER ||
  3986.           args[2].u.vec->size != keys->size) {
  3987.             bad_arg(3,F_ASSOC);
  3988.         }
  3989.         data = args[2].u.vec;
  3990.         }
  3991.         if (num_arg == 4) {
  3992.         fail_val = &args[3];
  3993.         } else {
  3994.         fail_val = &const0;
  3995.         }
  3996.     } else {
  3997.         keys = args[1].u.vec->item[0].u.vec;
  3998.         if (args[1].u.vec->size > 1) {
  3999.         if (args[1].u.vec->item[1].type != T_POINTER ||
  4000.             args[1].u.vec->item[1].u.vec->size != keys->size) {
  4001.             bad_arg(2,F_ASSOC);
  4002.             }
  4003.         data = args[1].u.vec->item[1].u.vec;
  4004.         } else {
  4005.         data = (struct vector *)NULL;
  4006.         }
  4007.         if (num_arg == 3) fail_val = &args[2];
  4008.         else if (num_arg == 2) fail_val = &const0;
  4009.         else {
  4010.         error ("too many args to efun assoc");
  4011.         }
  4012.     }
  4013.     ix = assoc(&args[0],keys);
  4014.     if (data == (struct vector *)NULL) {
  4015.         pop_n_elems(num_arg);
  4016.         push_number(ix);
  4017.     } else {
  4018.         assign_svalue(args, ix==-1 ? fail_val : &data->item[ix]);
  4019.         pop_n_elems(num_arg-1);
  4020.     }
  4021.         break;
  4022.     }
  4023. #endif /* F_ASSOC */
  4024. #ifdef F_INTERSECT_ALIST
  4025.     CASE(F_INTERSECT_ALIST);
  4026.     {
  4027.     extern struct vector *intersect_alist
  4028.       PROT((struct vector *, struct vector *));
  4029.     struct vector *tmp = intersect_alist( (sp-1)->u.vec, sp->u.vec );
  4030.     pop_stack();
  4031.     free_vector(sp->u.vec);
  4032.     sp->u.vec = tmp;
  4033.     }
  4034. #endif /* F_INTERSECT_ALIST */
  4035. #ifdef F_DEBUG_INFO
  4036.     CASE(F_DEBUG_INFO);
  4037.     {
  4038.     struct svalue *arg = sp-num_arg+1;
  4039.     struct svalue res;
  4040.  
  4041.     switch ( arg[0].u.number ) {
  4042.         case 0:
  4043.         {
  4044.         int flags;
  4045.         struct object *obj2;
  4046.  
  4047.         if (num_arg != 2)
  4048.                 error("bad number of arguments to debug_info");
  4049.         if ( arg[1].type != T_OBJECT)
  4050.             bad_arg(1,instruction);
  4051.         ob = arg[1].u.ob;
  4052.         flags = ob->flags;
  4053.         add_message("O_HEART_BEAT      : %s\n",
  4054.           flags&O_HEART_BEAT      ?"TRUE":"FALSE");
  4055.         add_message("O_IS_WIZARD       : %s\n",
  4056.           flags&O_IS_WIZARD       ?"TRUE":"FALSE");
  4057.         add_message("O_ENABLE_COMMANDS : %s\n",
  4058.           flags&O_ENABLE_COMMANDS ?"TRUE":"FALSE");
  4059.         add_message("O_CLONE           : %s\n",
  4060.           flags&O_CLONE           ?"TRUE":"FALSE");
  4061.         add_message("O_DESTRUCTED      : %s\n",
  4062.           flags&O_DESTRUCTED      ?"TRUE":"FALSE");
  4063.         add_message("O_SWAPPED         : %s\n",
  4064.           flags&O_SWAPPED          ?"TRUE":"FALSE");
  4065.         add_message("O_ONCE_INTERACTIVE: %s\n",
  4066.           flags&O_ONCE_INTERACTIVE?"TRUE":"FALSE");
  4067.         add_message("O_APPROVED        : %s\n",
  4068.           flags&O_APPROVED        ?"TRUE":"FALSE");
  4069.         add_message("O_RESET_STATE     : %s\n",
  4070.           flags&O_RESET_STATE     ?"TRUE":"FALSE");
  4071.         add_message("O_WILL_CLEAN_UP   : %s\n",
  4072.           flags&O_WILL_CLEAN_UP   ?"TRUE":"FALSE");
  4073.             add_message("total light : %d\n", ob->total_light);
  4074.         add_message("next_reset  : %d\n", ob->next_reset);
  4075.         add_message("time_of_ref : %d\n", ob->time_of_ref);
  4076.         add_message("ref         : %d\n", ob->ref);
  4077. #ifdef DEBUG
  4078.         add_message("extra_ref   : %d\n", ob->extra_ref);
  4079. #endif
  4080.         add_message("swap_num    : %ld\n", ob->swap_num);
  4081.         add_message("name        : '%s'\n", ob->name);
  4082.         add_message("next_all    : OBJ(%s)\n",
  4083.           ob->next_all?ob->next_all->name:"NULL");
  4084.         if (obj_list == ob) add_message(
  4085.             "This object is the head of the object list.\n");
  4086.         for (obj2=obj_list,i=1; obj2; obj2=obj2->next_all,i++)
  4087.             if (obj2->next_all == ob) {
  4088.             add_message(
  4089.                 "Previous object in object list: OBJ(%s)\n",
  4090.                 obj2->name);
  4091.             add_message("position in object list:%d\n",i);
  4092.             }
  4093.         assign_svalue_no_free(&res,&const0);
  4094.         break;
  4095.         }
  4096.         case 1: {
  4097.         if (num_arg != 2)
  4098.                 error("bad number of arguments to debug_info");
  4099.         if ( arg[1].type != T_OBJECT)
  4100.             bad_arg(1,instruction);
  4101.         ob = arg[1].u.ob;
  4102.         
  4103.         add_message("program ref's %d\n", ob->prog->ref);
  4104.         add_message("Name %s\n", ob->prog->name);
  4105.         add_message("program size %d\n",
  4106.         ob->prog->program_size);
  4107.         add_message("num func's %d (%d) \n", ob->prog->num_functions
  4108.         ,ob->prog->num_functions * sizeof(struct function));
  4109.         add_message("num strings %d\n", ob->prog->num_strings);
  4110.         add_message("num vars %d (%d)\n", ob->prog->num_variables
  4111.         ,ob->prog->num_variables * sizeof(struct variable));
  4112.         add_message("num inherits %d (%d)\n", ob->prog->num_inherited
  4113.         ,ob->prog->num_inherited * sizeof(struct inherit));
  4114.         add_message("total size %d\n", ob->prog->total_size);
  4115.         assign_svalue_no_free(&res,&const0);
  4116.         break;
  4117.         }
  4118.         default: bad_arg(1,instruction);
  4119.     }
  4120.     pop_n_elems(num_arg);
  4121.     sp++;
  4122.     *sp=res;
  4123.     break;
  4124.     }
  4125. #endif /* F_DEBUG_INFO */
  4126.     }
  4127. #ifdef DEBUG
  4128.     if (expected_stack && expected_stack != sp ||
  4129.     sp < fp + csp->num_local_variables - 1)
  4130.     {
  4131.     fatal("Bad stack after evaluation. Instruction %d, num arg %d\n",
  4132.           instruction, num_arg);
  4133.     }
  4134. #endif /* DEBUG */
  4135.     goto again;
  4136. }
  4137.  
  4138. /*
  4139.  * Can't the function pointed to by 'pr', defined in 'to', be called
  4140.  * from 'from' ?
  4141.  */
  4142.  
  4143. #define invalid_call(from, to, pr) \
  4144.     (((pr)->type & TYPE_MOD_PRIVATE) || ((pr)->flags & NAME_UNDEFINED) || \
  4145.     (((pr)->type&(TYPE_MOD_STATIC | TYPE_MOD_PRIVATE)) && ((from) != (to))))
  4146.  
  4147. #ifdef mac
  4148. #pragma segment interpret2
  4149. #endif
  4150.  
  4151. /*
  4152.  * Apply a fun 'fun' to the program in object 'ob', with
  4153.  * 'num_arg' arguments (already pushed on the stack).
  4154.  * If the function is not found, search in the object pointed to by the
  4155.  * inherit pointer.
  4156.  * If the function name starts with '::', search in the object pointed out
  4157.  * through the inherit pointer by the current object. The 'current_object'
  4158.  * stores the base object, not the object that has the current function being
  4159.  * evaluated. Thus, the variable current_prog will normally be the same as
  4160.  * current_object->prog, but not when executing inherited code. Then,
  4161.  * it will point to the code of the inherited object. As more than one
  4162.  * object can be inherited, the call of function by index number has to
  4163.  * be adjusted. The function number 0 in a superclass object must not remain
  4164.  * number 0 when it is inherited from a subclass object. The same problem
  4165.  * exists for variables. The global variables function_index_offset and
  4166.  * variable_index_offset keep track of how much to adjust the index when
  4167.  * executing code in the superclass objects.
  4168.  *
  4169.  * There is a special case when called from the heart beat, as
  4170.  * current_prog will be 0. When it is 0, set current_prog
  4171.  * to the 'ob->prog' sent as argument.
  4172.  *
  4173.  * Arguments are always removed from the stack.
  4174.  * If the function is not found, return 0 and nothing on the stack.
  4175.  * Otherwise, return 1, and a pushed return value on the stack.
  4176.  *
  4177.  * Note that the object 'ob' can be destructed. This must be handled by
  4178.  * the caller of apply().
  4179.  *
  4180.  * If the function failed to be called, then arguments must be deallocated
  4181.  * manually !
  4182.  */
  4183.  
  4184. char debug_apply_fun[30]; /* For debugging */
  4185.  
  4186. static int cache_id[0x40];
  4187.  
  4188. void flush_instr_cache(void)
  4189. {
  4190.     memset(cache_id, 0, sizeof cache_id);
  4191. }
  4192.  
  4193. #ifdef CACHE_CALL_OTHER
  4194. static int apply_low(fun, ob, num_arg, findex)
  4195.     char *fun;
  4196.     struct object *ob;
  4197.     int num_arg;
  4198.     short *findex;
  4199. #else
  4200. static int apply_low(fun, ob, num_arg)
  4201.     char *fun;
  4202.     struct object *ob;
  4203.     int num_arg;
  4204. #endif
  4205. {
  4206.     static char *cache_name[0x40];
  4207.     static struct function *cache_pr[0x40];
  4208.     static struct function *cache_pr_inherited[0x40];
  4209.     static struct program *cache_progp[0x40];
  4210.     static int cache_function_index_offset[0x40];
  4211.     static int cache_variable_index_offset[0x40];
  4212.  
  4213.     struct function *pr;
  4214.     struct program *progp;
  4215.     extern int num_error;
  4216.     struct control_stack *save_csp;
  4217.     int ix;
  4218.     short fix;
  4219.     char * funname;
  4220. #if 0
  4221.     int dbg;
  4222.  
  4223.     if (dbg = !strcmp(fun, "clone"))
  4224.     printf("apply_low: %s,%s\n",current_object->name, ob->name);
  4225. #endif
  4226.     ob->time_of_ref = current_time;    /* Used by the swapper */
  4227.     /*
  4228.      * This object will now be used, and is thus a target for
  4229.      * reset later on (when time due).
  4230.      */
  4231.     ob->flags &= ~O_RESET_STATE;
  4232. #ifdef DEBUG
  4233.     strncpy(debug_apply_fun, fun, sizeof debug_apply_fun);
  4234.     debug_apply_fun[sizeof debug_apply_fun - 1] = '\0';
  4235. #endif
  4236.     if (num_error > 0)
  4237.     goto failure;
  4238.     if (fun[0] == ':')
  4239.     error("Illegal function call\n");
  4240.     /*
  4241.      * If there is a chain of objects shadowing, start with the first
  4242.      * of these.
  4243.      */
  4244.     while (ob->shadowed && ob->shadowed != current_object)
  4245.     ob = ob->shadowed;
  4246. retry_for_shadow:
  4247.     if (ob->flags & O_SWAPPED)
  4248.     load_ob_from_swap(ob);
  4249.     progp = ob->prog;
  4250. #ifdef DEBUG
  4251.     if (ob->flags & O_DESTRUCTED) {
  4252.     printf("current object = %s, object = %s, function = %s\n",
  4253.         current_object->name, ob->name, fun);
  4254.     fatal("apply() on destructed object\n");
  4255.     }
  4256. #endif
  4257.     ix = ( progp->id_number ^ (int)fun ^ ( (int)fun >> 6 ) ) & 0x3f;
  4258.     if (cache_id[ix] == progp->id_number && !strcmp(cache_name[ix], fun) &&
  4259.     (!cache_progp[ix] || cache_progp[ix] == ob->prog)) {
  4260.         /* We have found a matching entry in the cache. The pointer to
  4261.        the function name has to match, not only the contents.
  4262.        This is because hashing the string in order to get a cache index
  4263.        would be much more costly than hashing it's pointer.
  4264.        If cache access would be costly, the cache would be useless.
  4265.        */
  4266.     if (cache_progp[ix] && !invalid_call(current_object, ob, cache_pr[ix])){
  4267.     /* the cache will tell us in wich program the function is, and
  4268.          * where
  4269.          */
  4270. #if 0
  4271.         if (dbg)
  4272.         printf("Cached entry.\n");
  4273. #endif
  4274.         push_control_stack(cache_pr[ix]);
  4275.         csp->num_local_variables = num_arg;
  4276.         current_prog = cache_progp[ix];
  4277.         pr = cache_pr_inherited[ix];
  4278.         function_index_offset = cache_function_index_offset[ix];
  4279.         variable_index_offset = cache_variable_index_offset[ix];
  4280.         /* Remove excessive arguments */
  4281.         while(csp->num_local_variables > pr->num_arg) {
  4282.         pop_stack();
  4283.         csp->num_local_variables--;
  4284.         }
  4285.         /* Correct number of arguments and local variables */
  4286.         while(csp->num_local_variables < pr->num_arg + pr->num_local) {
  4287.         push_number(0);
  4288.         csp->num_local_variables++;
  4289.         }
  4290.         tracedepth++;
  4291.         if (TRACEP(TRACE_CALL)) {
  4292.         do_trace_call(pr);
  4293.         }
  4294.         fp = sp - csp->num_local_variables + 1;
  4295.         break_sp = (short*)(sp+1);
  4296. #ifdef OLD_PREVIOUS_OBJECT_BEHAVIOUR
  4297.         /* Now, previous_object() is always set, even by
  4298.          * call_other(this_object()). It should not break any
  4299.          * compatibility.
  4300.          */
  4301.         if (current_object != ob)
  4302. #endif
  4303.         previous_ob = current_object;
  4304.         current_object = ob;
  4305.         save_csp = csp;
  4306.         eval_instruction(current_prog->program + pr->offset);
  4307. #ifdef DEBUG
  4308.         if (save_csp-1 != csp)
  4309.         fatal("Bad csp after execution in apply_low\n");
  4310. #endif
  4311.         /*
  4312.          * Arguments and local variables are now removed. One
  4313.          * resulting value is always returned on the stack.
  4314.          */
  4315.         return 1;
  4316.     } /* when we come here, the cache has told us that the function isn't
  4317.        * defined in the object
  4318.        */
  4319.     } else {
  4320.     /* we have to search the function */
  4321.     if (!cache_progp[ix] && cache_id[ix]) {
  4322.         /* The old cache entry was for an undefined function, so the
  4323.            name had to be malloced */
  4324.         xfree(cache_name[ix]);
  4325.     }
  4326.     cache_id[ix] = progp->id_number;
  4327.     if (funname = findstring(fun)) /* If the name is amongst strings */
  4328.     {
  4329. #ifdef CACHE_CALL_OTHER 
  4330.         if (*findex >= 0 && (*findex < progp->num_functions))
  4331.         {
  4332.         pr = &progp->functions[*findex];
  4333.              /* Comparing pointers ok with unique strings */
  4334.         if (pr->name == 0 || pr->name != funname ||
  4335.             invalid_call(current_object, ob, pr))
  4336.         {
  4337.             pr = progp->functions;
  4338.         }
  4339.         }
  4340.         else
  4341.         pr = progp->functions;
  4342.         
  4343.         for(fix = 0; 
  4344.         pr < progp->functions + progp->num_functions; pr++, fix++)
  4345. #else
  4346.         for(pr = progp->functions; 
  4347.             pr < progp->functions + progp->num_functions; pr++)
  4348. #endif
  4349.         {
  4350.         eval_cost++;
  4351.             /* Comparing pointers ok with unique strings */
  4352. #if 1
  4353.         if (pr->name && pr->name == funname) {
  4354.             if (((pr->type & TYPE_MOD_STATIC) && current_object != ob)
  4355.               || (pr->flags & NAME_UNDEFINED))
  4356.             break;
  4357.             if (pr->type & TYPE_MOD_PRIVATE)
  4358.             continue;
  4359.         }
  4360.         else
  4361.             continue;
  4362. #else
  4363.         if (pr->name == 0 || pr->name != funname ||
  4364.             invalid_call(current_object, ob, pr))
  4365.         {
  4366.             continue;
  4367.         }
  4368. #endif
  4369.         /* The searched function is found */
  4370. #ifdef CACHE_CALL_OTHER
  4371.         *findex = fix;
  4372. #endif
  4373.         cache_pr[ix] = pr;
  4374.         cache_name[ix] = pr->name;
  4375.         push_control_stack(pr);
  4376.         csp->num_local_variables = num_arg;
  4377.         current_prog = progp;
  4378.         pr = setup_new_frame(pr);
  4379.         cache_pr_inherited[ix] = pr;
  4380.         cache_progp[ix] = current_prog;
  4381.         cache_variable_index_offset[ix] = variable_index_offset;
  4382.         cache_function_index_offset[ix] = function_index_offset;
  4383. #ifdef OLD_PREVIOUS_OBJECT_BEHAVIOUR
  4384.         if (current_object != ob)
  4385. #endif
  4386.             previous_ob = current_object;
  4387.         current_object = ob;
  4388.         save_csp = csp;
  4389.         eval_instruction(current_prog->program + pr->offset);
  4390. #ifdef DEBUG
  4391.         if (save_csp-1 != csp)
  4392.             fatal("Bad csp after execution in apply_low\n");
  4393. #endif
  4394.         /*
  4395.          * Arguments and local variables are now removed. One
  4396.          * resulting value is always returned on the stack.
  4397.          */
  4398.         return 1;
  4399.         }
  4400.     }
  4401.     /* We have to mark a function not to be in the object */
  4402.     cache_name[ix] = string_copy(fun);
  4403.     cache_progp[ix] = (struct program *)0;
  4404.     }
  4405.     if (ob->shadowing) {
  4406.     /*
  4407.      * This is an object shadowing another. The function was not found,
  4408.      * but can maybe be found in the object we are shadowing.
  4409.      */
  4410.     ob = ob->shadowing;
  4411.     goto retry_for_shadow;
  4412.     }
  4413. failure:
  4414.     /* Failure. Deallocate stack. */
  4415.     pop_n_elems(num_arg);
  4416.     return 0;
  4417. }
  4418.  
  4419. /*
  4420.  * Arguments are supposed to be
  4421.  * pushed (using push_string() etc) before the call. A pointer to a
  4422.  * 'struct svalue' will be returned. It will be a null pointer if the called
  4423.  * function was not found. Otherwise, it will be a pointer to a static
  4424.  * area in apply(), which will be overwritten by the next call to apply.
  4425.  * Reference counts will be updated for this value, to ensure that no pointers
  4426.  * are deallocated.
  4427.  */
  4428.  
  4429. static struct svalue *sapply(fun, ob, num_arg)
  4430.     char *fun;
  4431.     struct object *ob;
  4432.     int num_arg;
  4433. {
  4434. #ifdef CACHE_CALL_OTHER
  4435.     short fix = -1;
  4436. #endif
  4437.  
  4438. #ifdef DEBUG
  4439.     struct svalue *expected_sp;
  4440. #endif
  4441.     static struct svalue ret_value = { T_NUMBER };
  4442.  
  4443.     if (TRACEP(TRACE_APPLY)) {
  4444.     do_trace("Apply", "", "\n");
  4445.     }
  4446. #ifdef DEBUG
  4447.     expected_sp = sp - num_arg;
  4448. #endif
  4449. #ifdef CACHE_CALL_OTHER
  4450.     if (apply_low(fun, ob, num_arg, &fix) == 0)
  4451. #else
  4452.     if (apply_low(fun, ob, num_arg) == 0)
  4453. #endif
  4454.     return 0;
  4455.     assign_svalue(&ret_value, sp);
  4456.     pop_stack();
  4457. #ifdef DEBUG
  4458.     if (expected_sp != sp)
  4459.     fatal("Corrupt stack pointer.\n");
  4460. #endif
  4461.     return &ret_value;
  4462. }
  4463.  
  4464. struct svalue *apply(fun, ob, num_arg)
  4465.     char *fun;
  4466.     struct object *ob;
  4467.     int num_arg;
  4468. {
  4469.     tracedepth = 0;
  4470.     return sapply(fun, ob, num_arg);
  4471. }
  4472.  
  4473. /*
  4474.  * This function is similar to apply(), except that it will not
  4475.  * call the function, only return object name if the function exists,
  4476.  * or 0 otherwise.
  4477.  */
  4478. char *function_exists(fun, ob)
  4479.     char *fun;
  4480.     struct object *ob;
  4481. {
  4482.     struct function *pr;
  4483.     char *shared_str;
  4484.  
  4485. #ifdef DEBUG
  4486.     if (ob->flags & O_DESTRUCTED)
  4487.     fatal("function_exists() on destructed object\n");
  4488. #endif
  4489.     if (ob->flags & O_SWAPPED)
  4490.     load_ob_from_swap(ob);
  4491.     pr = ob->prog->functions;
  4492.     if (shared_str = findstring(fun)) {
  4493.     for(; pr < ob->prog->functions + ob->prog->num_functions; pr++) {
  4494.         struct program *progp;
  4495.  
  4496.         if (shared_str != pr->name || (pr->type & TYPE_MOD_PRIVATE))
  4497.         continue;
  4498.         /* Static functions may not be called from outside. */
  4499.         if ((pr->type & TYPE_MOD_STATIC) && current_object != ob)
  4500.         continue;
  4501.         if (pr->flags & NAME_UNDEFINED)
  4502.         return 0;
  4503.         for (progp = ob->prog; pr->flags & NAME_INHERITED;) {
  4504.         progp = progp->inherit[pr->offset].prog;
  4505.         pr = &progp->functions[pr->function_index_offset];
  4506.         }
  4507.         return progp->name;
  4508.         }
  4509.     }
  4510.     return 0;
  4511. }
  4512.  
  4513. /*
  4514.  * Call a specific function address in an object. This is done with no
  4515.  * frame set up. It is expected that there are no arguments. Returned
  4516.  * values are removed.
  4517.  */
  4518.  
  4519. void call_function(progp, pr)
  4520.     struct program *progp;
  4521.     struct function *pr;
  4522. {
  4523.     if (pr->flags & NAME_UNDEFINED)
  4524.     return;
  4525.     push_control_stack(pr);
  4526. #ifdef DEBUG
  4527.     if (csp != control_stack)
  4528.     fatal("call_function with bad csp\n");
  4529. #endif
  4530.     csp->num_local_variables = 0;
  4531.     current_prog = progp;
  4532.     pr = setup_new_frame(pr);
  4533.     previous_ob = current_object;
  4534.     tracedepth = 0;
  4535.     eval_instruction(current_prog->program + pr->offset);
  4536.     pop_stack();    /* Throw away the returned result */
  4537. }
  4538.  
  4539. /*
  4540.  * This can be done much more efficiently, but the fix has
  4541.  * low priority.
  4542.  */
  4543. static int get_line_number(p, progp)
  4544.     char *p;
  4545.     struct program *progp;
  4546. {
  4547.     int offset;
  4548.     int i;
  4549.     if (progp == 0)
  4550.     return 0;
  4551.     offset = p - progp->program;
  4552. #ifdef DEBUG
  4553.     if (offset > progp->program_size)
  4554.     fatal("Illegal offset %d in object %s\n", offset, progp->name);
  4555. #endif
  4556.     for (i=0; offset > progp->line_numbers[i]; i++)
  4557.     ;
  4558.     return i + 1;
  4559. }
  4560.     
  4561. /*
  4562.  * Write out a trace. If there is an heart_beat(), then return the
  4563.  * object that had that heart beat.
  4564.  */
  4565. char *dump_trace(how)
  4566.     int how;
  4567. {
  4568.     struct control_stack *p;
  4569.     char *ret = 0;
  4570. #ifdef DEBUG
  4571.     int last_instructions PROT((void));
  4572. #endif
  4573.  
  4574.     if (current_prog == 0)
  4575.     return 0;
  4576.     if (csp < &control_stack[0]) {
  4577.     (void)printf("No trace.\n");
  4578.     debug_message("No trace.\n");
  4579.     return 0;
  4580.     }
  4581. #ifdef DEBUG
  4582. #ifdef TRACE_CODE
  4583.     if (how)
  4584.     (void)last_instructions();
  4585. #endif
  4586. #endif
  4587.     for (p = &control_stack[0]; p < csp; p++) {
  4588.     (void)printf("'%15s' in '%20s' ('%20s')line %d\n",
  4589.              p[0].funp ? p[0].funp->name : "CATCH",
  4590.              p[1].prog->name, p[1].ob->name,
  4591.              get_line_number(p[1].pc, p[1].prog));
  4592.     debug_message("'%15s' in '%20s' ('%20s')line %d\n",
  4593.              p[0].funp ? p[0].funp->name : "CATCH",
  4594.              p[1].prog->name, p[1].ob->name,
  4595.              get_line_number(p[1].pc, p[1].prog));
  4596.     if (p->funp && strcmp(p->funp->name, "heart_beat") == 0)
  4597.         ret = p->ob?p->ob->name:0; /*crash unliked gc*/
  4598.     }
  4599.     (void)printf("'%15s' in '%20s' ('%20s')line %d\n",
  4600.          p[0].funp ? p[0].funp->name : "CATCH",
  4601.          current_prog->name, current_object->name,
  4602.          get_line_number(pc, current_prog));
  4603.     debug_message("'%15s' in '%20s' ('%20s')line %d\n",
  4604.          p[0].funp ? p[0].funp->name : "CATCH",
  4605.          current_prog->name, current_object->name,
  4606.          get_line_number(pc, current_prog));
  4607.     return ret;
  4608. }
  4609.  
  4610. int get_line_number_if_any() {
  4611.     if (current_prog)
  4612.     return get_line_number(pc, current_prog);
  4613.     return 0;
  4614. }
  4615.  
  4616. static char *find_percent(str)
  4617.     char *str;
  4618. {
  4619.     while(1) {
  4620.     str = strchr(str, '%');
  4621.     if (str == 0)
  4622.         return 0;
  4623.     if (str[1] != '%')
  4624.         return str;
  4625.     str++;
  4626.     }
  4627. }
  4628.  
  4629. static int inter_sscanf(num_arg)
  4630.     int num_arg;
  4631. {
  4632.     char *fmt;        /* Format description */
  4633.     char *in_string;    /* The string to be parsed. */
  4634.     int number_of_matches;
  4635.     char *cp;
  4636.     struct svalue *arg = sp - num_arg + 1;
  4637.  
  4638.     /*
  4639.      * First get the string to be parsed.
  4640.      */
  4641.     if (arg[0].type != T_STRING)
  4642.     bad_arg(1, F_SSCANF);
  4643.     in_string = arg[0].u.string;
  4644.     if (in_string == 0)
  4645.     return 0;
  4646.     /*
  4647.      * Now get the format description.
  4648.      */
  4649.     if (arg[1].type != T_STRING)
  4650.     bad_arg(2, F_SSCANF);
  4651.     fmt = arg[1].u.string;
  4652.     /*
  4653.      * First, skip and match leading text.
  4654.      */
  4655.     for (cp=find_percent(fmt); fmt != cp; fmt++, in_string++) {
  4656.     if (in_string[0] == '\0' || fmt[0] != in_string[0])
  4657.         return 0;
  4658.     }
  4659.     /*
  4660.      * Loop for every % or substring in the format. Update num_arg and the
  4661.      * arg pointer continuosly. Assigning is done manually, for speed.
  4662.      */
  4663.     num_arg -= 2;
  4664.     arg += 2;
  4665.     for (number_of_matches=0; num_arg > 0;
  4666.      number_of_matches++, num_arg--, arg++) {
  4667.     int i, type;
  4668.  
  4669.     if (fmt[0] == '\0') {
  4670.         /*
  4671.          * We have reached end of the format string.
  4672.          * If there are any chars left in the in_string,
  4673.          * then we put them in the last variable (if any).
  4674.          */
  4675.         if (in_string[0]) {
  4676.         free_svalue(arg->u.lvalue);
  4677.         arg->u.lvalue->type = T_STRING;
  4678.         arg->u.lvalue->u.string = string_copy(in_string);
  4679.         arg->u.lvalue->string_type = STRING_MALLOC;
  4680.         number_of_matches++;
  4681.         }
  4682.         break;
  4683.     }
  4684. #ifdef DEBUG
  4685.     if (fmt[0] != '%')
  4686.         fatal("Should be a %% now !\n");
  4687. #endif
  4688.     type = T_STRING;
  4689.     if (fmt[1] == 'd')
  4690.         type = T_NUMBER;
  4691.     else if (fmt[1] != 's')
  4692.         error("Bad type : '%%%c' in sscanf fmt string.", fmt[1]);
  4693.     fmt += 2;
  4694.     /*
  4695.      * Parsing a number is the easy case. Just use strtol() to
  4696.      * find the end of the number.
  4697.      */
  4698.     if (type == T_NUMBER) {
  4699.         char *tmp = in_string;
  4700.         int tmp_num;
  4701.  
  4702.         tmp_num = (int) strtol(in_string, &in_string, 10);
  4703.         if(tmp == in_string) {
  4704.         /* No match */
  4705.         break;
  4706.         }
  4707.         free_svalue(arg->u.lvalue);
  4708.         arg->u.lvalue->type = T_NUMBER;
  4709.         arg->u.lvalue->u.number = tmp_num;
  4710.         while(fmt[0] && fmt[0] == in_string[0])
  4711.         fmt++, in_string++;
  4712.         if (fmt[0] != '%') {
  4713.         number_of_matches++;
  4714.         break;
  4715.         }
  4716.         continue;
  4717.     }
  4718.     /*
  4719.      * Now we have the string case.
  4720.      */
  4721.     cp = find_percent(fmt);
  4722.     if (cp == fmt)
  4723.         error("Illegal to have 2 adjacent %'s in fmt string in sscanf.");
  4724.     if (cp == 0)
  4725.         cp = fmt + strlen(fmt);
  4726.     /*
  4727.      * First case: There was no extra characters to match.
  4728.      * Then this is the last match.
  4729.      */
  4730.     if (cp == fmt) {
  4731.         free_svalue(arg->u.lvalue);
  4732.         arg->u.lvalue->type = T_STRING;
  4733.         arg->u.lvalue->u.string = string_copy(in_string);
  4734.         arg->u.lvalue->string_type = STRING_MALLOC;
  4735.         number_of_matches++;
  4736.         break;
  4737.     }
  4738.     for (i=0; in_string[i]; i++) {
  4739.         if (strncmp(in_string+i, fmt, cp - fmt) == 0) {
  4740.         char *match;
  4741.         /*
  4742.          * Found a match !
  4743.          */
  4744.         match = xalloc(i+1);
  4745.         (void)strncpy(match, in_string, i);
  4746.         in_string += i + cp - fmt;
  4747.         match[i] = '\0';
  4748.         free_svalue(arg->u.lvalue);
  4749.         arg->u.lvalue->type = T_STRING;
  4750.         arg->u.lvalue->u.string = match;
  4751.         arg->u.lvalue->string_type = STRING_MALLOC;
  4752.         fmt = cp;    /* Advance fmt to next % */
  4753.         break;
  4754.         }
  4755.     }
  4756.     if (fmt == cp)    /* If match, then do continue. */
  4757.         continue;
  4758.     /*
  4759.      * No match was found. Then we stop here, and return
  4760.      * the result so far !
  4761.      */
  4762.     break;
  4763.     }
  4764.     return number_of_matches;
  4765. }
  4766.  
  4767. /* test stuff ... -- LA */
  4768. #ifdef OPCPROF
  4769. void opcdump()
  4770. {
  4771.     int i;
  4772.  
  4773.     for(i = 0; i < MAXOPC; i++)
  4774.     if (opcount[i]) printf("%d: %d\n", i, opcount[i]);
  4775. }
  4776. #endif
  4777.  
  4778. /*
  4779.  * Reset the virtual stack machine.
  4780.  */
  4781. void reset_machine(first)
  4782.     int first;
  4783. {
  4784.     csp = control_stack - 1;
  4785.     if (first)
  4786.     sp = start_of_stack - 1;
  4787.     else
  4788.     pop_n_elems(sp - start_of_stack + 1);
  4789. }
  4790.  
  4791. #ifdef TRACE_CODE
  4792.  
  4793. static char *get_arg(a, b)
  4794.     int a, b;
  4795. {
  4796.     static char buff[10];
  4797.     char *from, *to;
  4798.  
  4799.     from = previous_pc[a]; to = previous_pc[b];
  4800.     if (to - from < 2)
  4801.     return "";
  4802.     if (to - from == 2) {
  4803.     sprintf(buff, "%d", from[1]);
  4804.     return buff;
  4805.     }
  4806.     if (to - from == 3) {
  4807.     short arg;
  4808.     ((char *)&arg)[0] = from[1];
  4809.     ((char *)&arg)[1] = from[2];
  4810.     sprintf(buff, "%d", arg);
  4811.     return buff;
  4812.     }
  4813.     if (to - from == 5) {
  4814.     int arg;
  4815.     ((char *)&arg)[0] = from[1];
  4816.     ((char *)&arg)[1] = from[2];
  4817.     ((char *)&arg)[2] = from[3];
  4818.     ((char *)&arg)[3] = from[4];
  4819.     sprintf(buff, "%d", arg);
  4820.     return buff;
  4821.     }
  4822.     return "";
  4823. }
  4824.  
  4825. int last_instructions() {
  4826.     int i;
  4827.     i = last;
  4828.     do {
  4829.     if (previous_instruction[i] != 0)
  4830.         printf("%6x: %3d %8s %-25s (%d)\n", previous_pc[i],
  4831.            previous_instruction[i],
  4832.            get_arg(i, (i+1) %
  4833.                (sizeof previous_instruction / sizeof (int))),
  4834.            get_f_name(previous_instruction[i]),
  4835.            stack_size[i] + 1);
  4836.     i = (i + 1) % (sizeof previous_instruction / sizeof (int));
  4837.     } while (i != last);
  4838.     return last;
  4839. }
  4840.  
  4841. #endif /* TRACE_CODE */
  4842.  
  4843.  
  4844. #ifdef DEBUG
  4845.  
  4846. static void count_inherits(progp, search_prog)
  4847.     struct program *progp, *search_prog;
  4848. {
  4849.     int i;
  4850.  
  4851.     /* Clones will not add to the ref count of inherited progs */
  4852.     if (progp->extra_ref != 1) return; /* marion */
  4853.     for (i=0; i< progp->num_inherited; i++) {
  4854.     progp->inherit[i].prog->extra_ref++;
  4855.     if (progp->inherit[i].prog == search_prog)
  4856.         printf("Found prog, inherited by %s\n", progp->name);
  4857.     count_inherits(progp->inherit[i].prog, search_prog);
  4858.     }
  4859. }
  4860.  
  4861. static void count_ref_in_vector(svp, num)
  4862.     struct svalue *svp;
  4863.     int num;
  4864. {
  4865.     struct svalue *p;
  4866.  
  4867.     for (p = svp; p < svp+num; p++) {
  4868.     switch(p->type) {
  4869.     case T_OBJECT:
  4870.         p->u.ob->extra_ref++;
  4871.         continue;
  4872.     case T_POINTER:
  4873.         count_ref_in_vector(&p->u.vec->item[0], p->u.vec->size);
  4874.         p->u.vec->extra_ref++;
  4875.         continue;
  4876.     }
  4877.     }
  4878. }
  4879.  
  4880. /*
  4881.  * Clear the extra debug ref count for vectors
  4882.  */
  4883. void clear_vector_refs(svp, num)
  4884.     struct svalue *svp;
  4885.     int num;
  4886. {
  4887.     struct svalue *p;
  4888.  
  4889.     for (p = svp; p < svp+num; p++) {
  4890.     switch(p->type) {
  4891.     case T_POINTER:
  4892.         clear_vector_refs(&p->u.vec->item[0], p->u.vec->size);
  4893.         p->u.vec->extra_ref = 0;
  4894.         continue;
  4895.     }
  4896.     }
  4897. }
  4898.  
  4899. /*
  4900.  * Loop through every object and variable in the game and check
  4901.  * all reference counts. This will surely take some time, and should
  4902.  * only be used for debugging.
  4903.  */
  4904. void check_a_lot_ref_counts(search_prog)
  4905.     struct program *search_prog;
  4906. {
  4907.     extern struct object *master_ob;
  4908.     struct object *ob;
  4909.  
  4910.     /*
  4911.      * Pass 1: clear the ref counts.
  4912.      */
  4913.     for (ob=obj_list; ob; ob = ob->next_all) {
  4914.     ob->extra_ref = 0;
  4915.     ob->prog->extra_ref = 0;
  4916.     clear_vector_refs(ob->variables, ob->prog->num_variables);
  4917.     }
  4918.     clear_vector_refs(start_of_stack, sp - start_of_stack + 1);
  4919.  
  4920.     /*
  4921.      * Pass 2: Compute the ref counts.
  4922.      */
  4923.  
  4924.     /*
  4925.      * List of all objects.
  4926.      */
  4927.     for (ob=obj_list; ob; ob = ob->next_all) {
  4928.     ob->extra_ref++;
  4929.     count_ref_in_vector(ob->variables, ob->prog->num_variables);
  4930.     ob->prog->extra_ref++;
  4931.     if (ob->prog == search_prog)
  4932.         printf("Found program for object %s\n", ob->name);
  4933.     /* Clones will not add to the ref count of inherited progs */
  4934.     if (ob->prog->extra_ref == 1)
  4935.         count_inherits(ob->prog, search_prog);
  4936.     }
  4937.  
  4938.     /*
  4939.      * The current stack.
  4940.      */
  4941.     count_ref_in_vector(start_of_stack, sp - start_of_stack + 1);
  4942.     update_ref_counts_for_players();
  4943.     count_ref_from_call_outs();
  4944.     if (master_ob) master_ob->extra_ref++; /* marion */
  4945.  
  4946.     if (search_prog)
  4947.     return;
  4948.  
  4949.     /*
  4950.      * Pass 3: Check the ref counts.
  4951.      */
  4952.     for (ob=obj_list; ob; ob = ob->next_all) {
  4953.     if (ob->ref != ob->extra_ref)
  4954.          fatal("Bad ref count in object %s, %d - %d\n", ob->name,
  4955.           ob->ref, ob->extra_ref);
  4956.     if (ob->prog->ref != ob->prog->extra_ref) {
  4957.         check_a_lot_ref_counts(ob->prog);
  4958.         fatal("Bad ref count in prog %s, %d - %d\n", ob->prog->name,
  4959.           ob->prog->ref, ob->prog->extra_ref);
  4960.     }
  4961.     }
  4962. }
  4963.  
  4964. #endif /* DEBUG */
  4965.  
  4966. /* Generate a debug message to the player */
  4967. static void
  4968. do_trace(msg, fname, post)
  4969. char *msg, *fname, *post;
  4970. {
  4971.     char buf[10000];
  4972.     char *objname;
  4973.  
  4974.     if (!TRACEHB)
  4975.     return;
  4976.     objname = TRACETST(TRACE_OBJNAME) ? (current_object && current_object->name ? current_object->name : "??")  : "";
  4977.     sprintf(buf, "*** %d %*s %s %s %s%s", tracedepth, tracedepth, "", msg, objname, fname, post);
  4978.     add_message(buf);
  4979. }
  4980.  
  4981. struct svalue *apply_master_ob(fun, num_arg)
  4982.     char *fun;
  4983.     int num_arg;
  4984. {
  4985.     extern struct object *master_ob;
  4986.  
  4987.     assert_master_ob_loaded();
  4988.     /*
  4989.      * Maybe apply() should be called instead ?
  4990.      */
  4991.     return sapply(fun, master_ob, num_arg);
  4992. }
  4993.  
  4994. void assert_master_ob_loaded()
  4995. {
  4996.     extern struct object *master_ob;
  4997.     static int inside = 0;
  4998. #ifndef COMPAT_MODE
  4999.     struct svalue *ret;
  5000. #endif
  5001.  
  5002.     if (master_ob == 0 || master_ob->flags & O_DESTRUCTED) {
  5003.     /*
  5004.      * The master object has been destructed. Free our reference,
  5005.      * and load a new one.
  5006.      *
  5007.      * This test is needed because the master object is called from
  5008.      * yyparse() at an error to find the wizard name. However, and error
  5009.      * when loading the master object will cause a recursive call to this
  5010.      * point.
  5011.      *
  5012.      * The best solution would be if the yyparse() did not have to call
  5013.      * the master object to find the name of the wizard.
  5014.      */
  5015.     if (inside) {
  5016.         fprintf(stderr, "Failed to load master object.\n");
  5017.         add_message("Failed to load master file !\n");
  5018.         LPExit(1);
  5019.     }
  5020.     fprintf(stderr, "assert_master_ob_loaded: Reloading master.c\n");
  5021.     if (master_ob)
  5022.         free_object(master_ob, "assert_master_ob_loaded");
  5023.     /*
  5024.      * Clear the pointer, in case the load failed.
  5025.      */
  5026.     master_ob = 0;
  5027.     inside = 1;
  5028. #ifdef COMPAT_MODE
  5029.     master_ob = load_object(MASTER_OBJECT,0,0);
  5030. #else
  5031.     ret = apply_master_ob("get_root_uid", 0);
  5032.     if (ret == 0 || ret->type != T_STRING) {
  5033.         fatal ("get_root_uid() in %s does not work\n",MASTER_OBJECT);
  5034.     }
  5035.     master_ob->user = add_name(ret->u.string);
  5036.     master_ob->eff_user = master_ob->user;
  5037. #endif
  5038.     inside = 0;
  5039.     add_ref(master_ob, "assert_master_ob_loaded");
  5040.     fprintf(stderr, "Reloading done.\n");
  5041.     }
  5042. }
  5043.  
  5044. /*
  5045.  * When an object is destructed, all references to it must be removed
  5046.  * from the stack.
  5047.  */
  5048. void remove_object_from_stack(ob)
  5049.     struct object *ob;
  5050. {
  5051.     struct svalue *svp;
  5052.  
  5053.     for (svp = start_of_stack; svp <= sp; svp++) {
  5054.     if (svp->type != T_OBJECT)
  5055.         continue;
  5056.     if (svp->u.ob != ob)
  5057.         continue;
  5058.     free_object(svp->u.ob, "remove_object_from_stack");
  5059.     svp->type = T_NUMBER;
  5060.     svp->u.number = 0;
  5061.     }
  5062. }
  5063.  
  5064. static int
  5065. strpref(p, s)
  5066. char *p, *s;
  5067. {
  5068.     while (*p)
  5069.     if (*p++ != *s++)
  5070.         return 0;
  5071.     return 1;
  5072. }
  5073.